|
100
|
1 ;;; $Id: hm--html.el,v 1.3 1997/02/24 01:13:28 steve Exp $
|
|
2
|
2 ;;;
|
|
98
|
3 ;;; Copyright (C) 1993 - 1997 Heiko Muenkel
|
|
0
|
4 ;;; email: muenkel@tnt.uni-hannover.de
|
|
|
5 ;;;
|
|
|
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
|
|
|
8 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
9 ;;; any later version.
|
|
|
10 ;;;
|
|
|
11 ;;; This program is distributed in the hope that it will be useful,
|
|
|
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
14 ;;; GNU General Public License for more details.
|
|
|
15 ;;;
|
|
|
16 ;;; You should have received a copy of the GNU General Public License
|
|
|
17 ;;; along with this program; if not, write to the Free Software
|
|
|
18 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
19 ;;;
|
|
|
20 ;;;
|
|
|
21 ;;; Description:
|
|
|
22 ;;;
|
|
|
23 ;;; Defines functions for the file hm--html-menu.el.
|
|
|
24 ;;;
|
|
|
25 ;;; Installation:
|
|
|
26 ;;;
|
|
|
27 ;;; Put this file in one of your load path directories.
|
|
|
28 ;;;
|
|
|
29
|
|
98
|
30 (defun hm--html-set-marker-at-position (&optional position)
|
|
|
31 "Creates a new marker and set the marker at the POSITION.
|
|
|
32 If POSITION is nil, then the marker is set at the current point.
|
|
|
33 The return value is the marker."
|
|
|
34 (let ((marker (make-marker)))
|
|
|
35 (if position
|
|
|
36 (set-marker marker position)
|
|
|
37 (set-marker marker (point)))))
|
|
0
|
38
|
|
|
39 ;;; Functions for adding html commands which consists of a start and a
|
|
|
40 ;;; end tag and some text between them. (Basicfunctions)
|
|
|
41
|
|
|
42 (defun hm--html-add-tags (function-insert-start-tag
|
|
|
43 start-tag
|
|
2
|
44 &optional
|
|
|
45 function-insert-end-tag
|
|
|
46 end-tag
|
|
|
47 function-insert-middle-start-tag
|
|
|
48 middle-start-tag
|
|
|
49 function-insert-middle-end-tag
|
|
|
50 middle-end-tag)
|
|
0
|
51 "Adds the start and the end html tag at point.
|
|
|
52 The first parameter specifies the funtion which insert the start tag
|
|
|
53 and the third parameter specifies the function which insert the end tag.
|
|
|
54 The second parameter is the string for the start tag and the fourth parameter
|
|
|
55 is the string for the end tag. The third and fourth parameters are optional.
|
|
|
56 The fifth parameter is optional. If it exists, it specifies a function which
|
|
98
|
57 inserts the sixth parameter (the middle-start-tag) between the start and the
|
|
|
58 end tag."
|
|
0
|
59 (eval (list function-insert-start-tag start-tag))
|
|
2
|
60 (if function-insert-middle-start-tag
|
|
|
61 (eval (list function-insert-middle-start-tag middle-start-tag)))
|
|
98
|
62 (let ((position (hm--html-set-marker-at-position (point))))
|
|
2
|
63 (if function-insert-middle-end-tag
|
|
|
64 (eval (list function-insert-middle-end-tag middle-end-tag)))
|
|
|
65 (if function-insert-end-tag
|
|
|
66 (eval (list function-insert-end-tag end-tag)))
|
|
|
67 (goto-char position)))
|
|
0
|
68
|
|
|
69
|
|
|
70 (defun hm--html-add-tags-to-region (function-insert-start-tag
|
|
|
71 start-tag
|
|
|
72 function-insert-end-tag
|
|
|
73 end-tag
|
|
98
|
74 &optional
|
|
|
75 function-insert-middle-tag
|
|
|
76 middle-tag)
|
|
0
|
77 "Adds the start and the end html tag to the active region.
|
|
|
78 The first parameter specifies the funtion which insert the start tag
|
|
|
79 and the third parameter specifies the function which insert the end tag.
|
|
|
80 The second parameter is the string for the start tag and the fourth parameter
|
|
|
81 is the string for the end tag.
|
|
|
82 The fifth parameter is optional. If it exists, it specifies a function which
|
|
|
83 inserts the sixth parameter (the middle-tag) between the start and the end
|
|
|
84 tag."
|
|
|
85 (save-window-excursion
|
|
98
|
86 (let ((start (hm--html-set-marker-at-position (region-beginning)))
|
|
0
|
87 (end (region-end)))
|
|
|
88 (goto-char end)
|
|
|
89 (eval (list function-insert-end-tag end-tag))
|
|
|
90 (goto-char start)
|
|
98
|
91 ; (backward-char (+ (length end-tag) (- end start)))
|
|
0
|
92 (eval (list function-insert-start-tag start-tag))
|
|
|
93 (if function-insert-middle-tag
|
|
|
94 (eval (list function-insert-middle-tag middle-tag)))
|
|
|
95 )))
|
|
|
96
|
|
|
97
|
|
|
98 (defun hm--html-insert-start-tag (tag)
|
|
|
99 "Inserts the HTML start tag 'tag' without a Newline.
|
|
|
100 The parameter must be a string (i.e. \"<B>\")"
|
|
|
101 (let ((start (point)))
|
|
|
102 (insert tag)
|
|
2
|
103 (hm--html-indent-region start (point))))
|
|
70
|
104 ; (html-maybe-deemphasize-region start (- (point) 1))))
|
|
0
|
105
|
|
|
106
|
|
|
107 (defun hm--html-insert-end-tag (tag)
|
|
|
108 "Inserts the HTML end tag 'tag' without a Newline.
|
|
|
109 The parameter must be a string (i.e. \"</B>\")"
|
|
|
110 (let ((start (point)))
|
|
|
111 (insert tag)
|
|
2
|
112 (hm--html-indent-region start (point))))
|
|
70
|
113 ; (html-maybe-deemphasize-region start (- (point) 1))))
|
|
0
|
114
|
|
|
115
|
|
|
116 (defun hm--html-insert-start-tag-with-newline (tag)
|
|
|
117 "Inserts the HTML start tag 'tag' with a Newline.
|
|
|
118 The parameter must be a string (i.e. \"<PRE>\")"
|
|
|
119 (let ((start (point)))
|
|
|
120 (insert tag)
|
|
2
|
121 (hm--html-indent-region start (point))
|
|
|
122 )
|
|
0
|
123 (insert "\n"))
|
|
|
124
|
|
|
125
|
|
|
126 (defun hm--html-insert-end-tag-with-newline (tag)
|
|
|
127 "Inserts the HTML end tag 'tag' with a Newline.
|
|
|
128 The parameter must be a string (i.e. \"</PRE>\")"
|
|
|
129 (insert "\n")
|
|
|
130 (let ((start (point)))
|
|
|
131 (insert tag)
|
|
2
|
132 (hm--html-indent-region start (point))))
|
|
0
|
133
|
|
|
134
|
|
|
135
|
|
|
136 ;;; Functions which add simple tags of the form <tag>
|
|
|
137
|
|
2
|
138 (defun hm--html-add-list-or-menu-item-separator ()
|
|
|
139 "Adds a list or menu item. Assume we're at the end of the last item."
|
|
|
140 (interactive)
|
|
|
141 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline "<LI> "))
|
|
|
142
|
|
|
143 (defun hm--html-add-list-or-menu-item ()
|
|
|
144 "Adds the tags for a menu item at the point in the current buffer."
|
|
|
145 (interactive)
|
|
|
146 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline "<LI> "
|
|
|
147 'hm--html-insert-end-tag " </LI>"))
|
|
|
148
|
|
|
149 (defun hm--html-add-list-or-menu-item-to-region ()
|
|
|
150 "Adds the tags for a menu item to the region in the current buffer."
|
|
|
151 (interactive)
|
|
|
152 (hm--html-add-tags-to-region 'hm--html-insert-start-tag "<LI> "
|
|
|
153 'hm--html-insert-end-tag " </LI>"))
|
|
|
154
|
|
100
|
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
|
|
0
|
161 (defun hm--html-add-line-break ()
|
|
|
162 "Adds the HTML tag for a line break."
|
|
|
163 (interactive)
|
|
|
164 (hm--html-add-tags 'hm--html-insert-start-tag "<BR>"))
|
|
|
165
|
|
|
166
|
|
|
167 (defun hm--html-add-horizontal-rule ()
|
|
|
168 "Adds the HTML tag for a horizontal rule (line)."
|
|
|
169 (interactive)
|
|
|
170 (hm--html-add-tags 'hm--html-insert-start-tag "<HR>"))
|
|
|
171
|
|
|
172
|
|
|
173 (defun hm--html-add-paragraph ()
|
|
|
174 "Adds the HTML tags for a paragraph at the point in the current buffer."
|
|
|
175 (interactive)
|
|
|
176 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
177 "<P>"
|
|
|
178 'hm--html-insert-end-tag-with-newline
|
|
|
179 "</P>"))
|
|
|
180
|
|
|
181
|
|
|
182 (defun hm--html-add-paragraph-to-region ()
|
|
|
183 "Adds the HTML tags for a paragraph to the region."
|
|
|
184 (interactive)
|
|
|
185 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
186 "<P>"
|
|
|
187 'hm--html-insert-end-tag-with-newline
|
|
|
188 "</P>"))
|
|
|
189
|
|
|
190
|
|
|
191 (defun hm--html-add-paragraph-separator ()
|
|
|
192 "Adds the tag for a paragraph seperator."
|
|
|
193 (interactive)
|
|
|
194 (hm--html-add-tags 'hm--html-insert-start-tag "<P>"))
|
|
|
195
|
|
100
|
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 "\">"))))
|
|
0
|
295
|
|
|
296
|
|
|
297 ;;; Functions which include something in HTML- documents
|
|
|
298
|
|
|
299 (defvar hm--html-url-history-list nil
|
|
|
300 "History list for the function 'hm--html-read-url'")
|
|
|
301
|
|
|
302
|
|
|
303 (defun hm--html-read-url-predicate (table-element-list usagesymbol)
|
|
|
304 "Predicatefunction for hm--html-read-url."
|
|
|
305 (hm--html-read-url-predicate-1 (cdr table-element-list) usagesymbol))
|
|
|
306
|
|
|
307
|
|
|
308 (defun hm--html-read-url-predicate-1 (table-element-list usagesymbol)
|
|
|
309 "Internal function of hm--html-read-url-predicate."
|
|
|
310 (cond ((not table-element-list) nil)
|
|
|
311 ((eq (car table-element-list) usagesymbol))
|
|
|
312 (t (hm--html-read-url-predicate-1 (cdr table-element-list)
|
|
|
313 usagesymbol))))
|
|
|
314
|
|
|
315
|
|
|
316 (defun hm--html-read-url (prompt &optional
|
|
|
317 table
|
|
|
318 predicate
|
|
|
319 require-match
|
|
|
320 initial-contents)
|
|
|
321 "Function prompts for a URL string.
|
|
|
322 TABLE is an alist whose elements' cars are URL's.
|
|
|
323 PREDICATE limits completion to a subset of TABLE.
|
|
|
324 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
|
|
|
325 the input is (or completes to) an element of TABLE.
|
|
|
326 INITIAL-CONTENTS is a string to insert in the minibuffer before reading.
|
|
|
327 If INITIAL-CONTENTS is nil, the car of the 'hm--html-url-history-list'
|
|
|
328 is used instead."
|
|
|
329 (if table
|
|
|
330 (completing-read prompt
|
|
|
331 table
|
|
|
332 predicate
|
|
|
333 require-match
|
|
|
334 initial-contents
|
|
|
335 hm--html-url-history-list)
|
|
|
336 (read-string prompt
|
|
|
337 (if initial-contents
|
|
|
338 initial-contents
|
|
|
339 (car hm--html-url-history-list))
|
|
|
340 hm--html-url-history-list)))
|
|
|
341
|
|
|
342
|
|
|
343 (defun hm--html-read-altenate (url)
|
|
|
344 "Function reads the value for the \"ALT\"- attribute in IMG tags.
|
|
|
345 URL will be used as the default URL for the external viewer."
|
|
|
346 (let ((alttype
|
|
|
347 (string-to-int
|
|
|
348 (completing-read
|
|
|
349 "0: No ALT atribute, 1: ALT=\"\", 2: ALT=Text: "
|
|
|
350 '(("0") ("1") ("2"))
|
|
|
351 nil
|
|
|
352 t
|
|
|
353 "2"))))
|
|
|
354 (cond ((= alttype 0) nil)
|
|
|
355 ((= alttype 1) "")
|
|
|
356 ((= alttype 2) (read-string
|
|
|
357 "Text for the ALT attribute: "
|
|
|
358 (substring (file-name-nondirectory url)
|
|
|
359 0
|
|
|
360 (string-match
|
|
|
361 "\\."
|
|
|
362 (file-name-nondirectory url)))))
|
|
|
363 )))
|
|
|
364
|
|
100
|
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
|
|
0
|
478
|
|
|
479 (defun hm--html-add-image-bottom (href alt)
|
|
|
480 "Add an image, bottom aligned."
|
|
|
481 (interactive (let ((url (hm--html-read-url "Image URL: ")))
|
|
|
482 (list url (hm--html-read-altenate url))))
|
|
2
|
483 (hm--html-add-tags
|
|
|
484 'hm--html-insert-start-tag
|
|
|
485 (concat "<IMG ALIGN=BOTTOM SRC=\""
|
|
|
486 href
|
|
|
487 (when alt
|
|
|
488 (concat "\" ALT=\"" alt))
|
|
|
489 "\">")))
|
|
0
|
490
|
|
|
491
|
|
|
492 (defun hm--html-add-image-middle (href alt)
|
|
|
493 "Add an image, middle aligned."
|
|
|
494 (interactive (let ((url (hm--html-read-url "Image URL: ")))
|
|
|
495 (list url (hm--html-read-altenate url))))
|
|
2
|
496 (hm--html-add-tags
|
|
|
497 'hm--html-insert-start-tag
|
|
|
498 (concat "<IMG ALIGN=MIDDLE SRC=\""
|
|
|
499 href
|
|
|
500 (when alt
|
|
|
501 (concat "\" ALT=\"" alt))
|
|
|
502 "\">")))
|
|
0
|
503
|
|
|
504
|
|
|
505 (defun hm--html-add-image-top (href alt)
|
|
|
506 "Add an image, top aligned."
|
|
|
507 (interactive (let ((url (hm--html-read-url "Image URL: ")))
|
|
|
508 (list url (hm--html-read-altenate url))))
|
|
2
|
509 (hm--html-add-tags
|
|
|
510 'hm--html-insert-start-tag
|
|
|
511 (concat "<IMG ALIGN=TOP SRC=\""
|
|
|
512 href
|
|
|
513 (when alt
|
|
|
514 (concat "\" ALT=\"" alt))
|
|
|
515 "\">")))
|
|
|
516
|
|
|
517
|
|
|
518 (defun hm--html-add-applet (name code width height)
|
|
|
519 "Add an applet."
|
|
|
520 (interactive (let ((name (read-string "Applet Name: " "applet"))
|
|
|
521 (code (read-file-name "Applet Class File: "))
|
|
|
522 (width (read-number "Width (i.e.: 100): " t))
|
|
|
523 (height (read-number "Height (i.e.: 100): " t)))
|
|
|
524 (list name code width height)))
|
|
|
525 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
526 (concat "<APPLET "
|
|
|
527 (if (string= name "")
|
|
|
528 ""
|
|
|
529 (concat "NAME=\"" name "\"\n"))
|
|
|
530 "CODE=\""
|
|
|
531 code
|
|
|
532 "\"\n"
|
|
|
533 "WIDTH=\""
|
|
|
534 width
|
|
|
535 "\"\n"
|
|
|
536 "HEIGHT=\""
|
|
|
537 height
|
|
|
538 "\">")
|
|
|
539 'hm--html-insert-start-tag-with-newline
|
|
|
540 "</APPLET>"))
|
|
|
541
|
|
|
542 (defun hm--html-add-applet-parameter (name value)
|
|
|
543 "Adds the tag for an applet parameter at the current point.
|
|
|
544 This tag must be added between <APPLET> and </APPLET>."
|
|
|
545 (interactive "sParameter Name: \nsParameter Value: ")
|
|
|
546 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
547 (concat "<PARAM "
|
|
|
548 "NAME=\""
|
|
|
549 name
|
|
|
550 "\" VALUE=\""
|
|
|
551 value
|
|
|
552 "\">")))
|
|
|
553
|
|
0
|
554
|
|
70
|
555 (defun hm--html-add-server-side-include-file (file)
|
|
|
556 "This function adds a server side include file directive in the buffer.
|
|
|
557 The directive is only supported by the NCSA http daemon."
|
|
|
558 (interactive "FInclude File: ")
|
|
|
559 (let ((start (point)))
|
|
|
560 (if (string= file "")
|
|
|
561 (error "ERROR: No filename specified !")
|
|
|
562 (insert "<INC SRV \"" file "\">"))))
|
|
|
563 ; (html-maybe-deemphasize-region (1+ start) (1- (point))))))
|
|
|
564
|
|
|
565
|
|
|
566 (defun hm--html-add-server-side-include-command-with-isindex-parameter
|
|
|
567 (command)
|
|
|
568 "This function adds a server side include command directive in the buffer.
|
|
|
569 The include command uses the \"isindex\"- parameter for the specified command."
|
|
|
570 (interactive (list
|
|
|
571 (completing-read "Include Command: "
|
|
|
572 hm--html-server-side-include-command-alist)))
|
|
|
573 (hm--html-add-server-side-include-command command t))
|
|
|
574
|
|
|
575
|
|
|
576 (defun hm--html-add-server-side-include-command (command &optional srvurl)
|
|
|
577 "This function adds a server side include command directive in the buffer.
|
|
|
578 The directive is only supported by the NCSA http daemon.
|
|
|
579 If SRVURL is t, then the attribute srvurl instead of srv is used for the
|
|
|
580 include command. With srvurl, the include command uses the \"isindex\"-
|
|
|
581 parameter for the specified command."
|
|
|
582 (interactive (list
|
|
|
583 (completing-read "Include Command: "
|
|
|
584 hm--html-server-side-include-command-alist)))
|
|
|
585 (let ((start (point))
|
|
|
586 (attribute (if srvurl "SRVURL" "SRV")))
|
|
|
587 (if (string= command "")
|
|
|
588 (error "ERROR: No command specified !")
|
|
|
589 (if (= ?| (string-to-char command))
|
|
|
590 (insert "<INC " attribute" \"" command "\">")
|
|
|
591 (insert "<INC " attribute " \"|" command "\">")))))
|
|
|
592 ; (html-maybe-deemphasize-region (1+ start) (1- (point)))))))
|
|
|
593
|
|
|
594
|
|
|
595 ;(defun hm--html-add-server-side-include-command-with-parameter (command
|
|
|
596 ; parameter)
|
|
|
597 ; "This function adds a server side include command directive in the buffer.
|
|
|
598 ;The directive is only supported by the NCSA http daemon."
|
|
|
599 ; (interactive (list
|
|
|
600 ; (completing-read
|
|
|
601 ; "Include Command: "
|
|
|
602 ; hm--html-server-side-include-command-with-parameter-alist)
|
|
|
603 ; (read-string "Parameterlist sepearted by '?': ")))
|
|
|
604 ; (let ((start (point)))
|
|
|
605 ; (if (string= command "")
|
|
|
606 ; (error "ERROR: No command specified !")
|
|
|
607 ; (if (string= parameter "")
|
|
|
608 ; (error "ERROR: No parameter specified !")
|
|
|
609 ; (if (= ?| (string-to-char command))
|
|
|
610 ; (if (= ?? (string-to-char parameter))
|
|
|
611 ; (insert "<INC SRVURL \"" command parameter "\">")
|
|
|
612 ; (insert "<INC SRVURL \"" command "?" parameter "\">"))
|
|
|
613 ; (if (= ?? (string-to-char parameter))
|
|
|
614 ; (insert "<INC SRVURL \"|" command parameter "\">")
|
|
|
615 ; (insert "<INC SRVURL \"|" command "?" parameter "\">")))
|
|
|
616 ; (html-maybe-deemphasize-region (1+ start) (1- (point)))))))
|
|
|
617
|
|
|
618
|
|
0
|
619
|
|
|
620 ;;; Functions, which adds tags of the form <starttag> ... </endtag>
|
|
|
621
|
|
2
|
622 (defun hm--html-add-big ()
|
|
|
623 "Adds the HTML tags for Big at the point in the current buffer."
|
|
|
624 (interactive)
|
|
|
625 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
626 "<BIG>"
|
|
|
627 'hm--html-insert-end-tag
|
|
|
628 "</BIG>"))
|
|
|
629
|
|
|
630
|
|
|
631 (defun hm--html-add-big-to-region ()
|
|
|
632 "Adds the HTML tags for Big to the region."
|
|
|
633 (interactive)
|
|
|
634 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
635 "<BIG>"
|
|
|
636 'hm--html-insert-end-tag
|
|
|
637 "</BIG>"))
|
|
|
638
|
|
|
639
|
|
|
640 (defun hm--html-add-small ()
|
|
|
641 "Adds the HTML tags for Small at the point in the current buffer."
|
|
|
642 (interactive)
|
|
|
643 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
644 "<SMALL>"
|
|
|
645 'hm--html-insert-end-tag
|
|
|
646 "</SMALL>"))
|
|
|
647
|
|
|
648
|
|
|
649 (defun hm--html-add-small-to-region ()
|
|
|
650 "Adds the HTML tags for Small to the region."
|
|
|
651 (interactive)
|
|
|
652 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
653 "<SMALL>"
|
|
|
654 'hm--html-insert-end-tag
|
|
|
655 "</SMALL>"))
|
|
|
656
|
|
|
657
|
|
0
|
658 (defun hm--html-add-bold ()
|
|
|
659 "Adds the HTML tags for Bold at the point in the current buffer."
|
|
|
660 (interactive)
|
|
|
661 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
662 "<B>"
|
|
|
663 'hm--html-insert-end-tag
|
|
|
664 "</B>"))
|
|
|
665
|
|
|
666
|
|
|
667 (defun hm--html-add-bold-to-region ()
|
|
|
668 "Adds the HTML tags for Bold to the region."
|
|
|
669 (interactive)
|
|
|
670 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
671 "<B>"
|
|
|
672 'hm--html-insert-end-tag
|
|
|
673 "</B>"))
|
|
|
674
|
|
|
675
|
|
|
676 (defun hm--html-add-italic ()
|
|
|
677 "Adds the HTML tags for Italic at the point in the current buffer."
|
|
|
678 (interactive)
|
|
|
679 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
680 "<I>"
|
|
|
681 'hm--html-insert-end-tag
|
|
|
682 "</I>"))
|
|
|
683
|
|
|
684
|
|
|
685 (defun hm--html-add-italic-to-region ()
|
|
|
686 "Adds the HTML tags for Italic to the region."
|
|
|
687 (interactive)
|
|
|
688 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
689 "<I>"
|
|
|
690 'hm--html-insert-end-tag
|
|
|
691 "</I>"))
|
|
|
692
|
|
|
693
|
|
|
694 (defun hm--html-add-underline ()
|
|
|
695 "Adds the HTML tags for Underline at the point in the current buffer."
|
|
|
696 (interactive)
|
|
|
697 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
698 "<U>"
|
|
|
699 'hm--html-insert-end-tag
|
|
|
700 "</U>"))
|
|
|
701
|
|
|
702
|
|
|
703 (defun hm--html-add-underline-to-region ()
|
|
|
704 "Adds the HTML tags for Underline to the region."
|
|
|
705 (interactive)
|
|
|
706 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
707 "<U>"
|
|
|
708 'hm--html-insert-end-tag
|
|
|
709 "</U>"))
|
|
|
710
|
|
|
711
|
|
|
712 (defun hm--html-add-definition ()
|
|
|
713 "Adds the HTML tags for Definition at the point in the current buffer."
|
|
|
714 (interactive)
|
|
|
715 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
716 "<DFN>"
|
|
|
717 'hm--html-insert-end-tag
|
|
|
718 "</DFN>"))
|
|
|
719
|
|
|
720
|
|
|
721 (defun hm--html-add-definition-to-region ()
|
|
|
722 "Adds the HTML tags for Definition to the region."
|
|
|
723 (interactive)
|
|
|
724 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
725 "<DFN>"
|
|
|
726 'hm--html-insert-end-tag
|
|
|
727 "</DFN>"))
|
|
|
728
|
|
|
729
|
|
|
730 (defun hm--html-add-code ()
|
|
|
731 "Adds the HTML tags for Code at the point in the current buffer."
|
|
|
732 (interactive)
|
|
|
733 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
734 "<CODE>"
|
|
|
735 'hm--html-insert-end-tag
|
|
|
736 "</CODE>"))
|
|
|
737
|
|
|
738
|
|
|
739 (defun hm--html-add-code-to-region ()
|
|
|
740 "Adds the HTML tags for Code to the region."
|
|
|
741 (interactive)
|
|
|
742 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
743 "<CODE>"
|
|
|
744 'hm--html-insert-end-tag
|
|
|
745 "</CODE>"))
|
|
|
746
|
|
|
747
|
|
2
|
748 (defun hm--html-add-citation ()
|
|
|
749 "Adds the HTML tags for Citation."
|
|
|
750 (interactive)
|
|
|
751 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
752 "<CITE>"
|
|
|
753 'hm--html-insert-end-tag
|
|
|
754 "</CITE>"))
|
|
|
755
|
|
0
|
756 (defun hm--html-add-citation-to-region ()
|
|
|
757 "Adds the HTML tags for Citation to the region."
|
|
|
758 (interactive)
|
|
|
759 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
760 "<CITE>"
|
|
|
761 'hm--html-insert-end-tag
|
|
|
762 "</CITE>"))
|
|
|
763
|
|
|
764
|
|
2
|
765 (defun hm--html-add-emphasized ()
|
|
|
766 "Adds the HTML tags for Emphasized."
|
|
|
767 (interactive)
|
|
|
768 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
769 "<EM>"
|
|
|
770 'hm--html-insert-end-tag
|
|
|
771 "</EM>"))
|
|
|
772
|
|
|
773
|
|
0
|
774 (defun hm--html-add-emphasized-to-region ()
|
|
|
775 "Adds the HTML tags for Emphasized to the region."
|
|
|
776 (interactive)
|
|
|
777 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
778 "<EM>"
|
|
|
779 'hm--html-insert-end-tag
|
|
|
780 "</EM>"))
|
|
|
781
|
|
|
782
|
|
2
|
783 (defun hm--html-add-fixed ()
|
|
|
784 "Adds the HTML tags for Fixed."
|
|
|
785 (interactive)
|
|
|
786 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
787 "<TT>"
|
|
|
788 'hm--html-insert-end-tag
|
|
|
789 "</TT>"))
|
|
|
790
|
|
|
791
|
|
0
|
792 (defun hm--html-add-fixed-to-region ()
|
|
|
793 "Adds the HTML tags for Fixed to the region."
|
|
|
794 (interactive)
|
|
|
795 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
796 "<TT>"
|
|
|
797 'hm--html-insert-end-tag
|
|
|
798 "</TT>"))
|
|
|
799
|
|
|
800
|
|
2
|
801 (defun hm--html-add-keyboard ()
|
|
|
802 "Adds the HTML tags for Keyboard."
|
|
|
803 (interactive)
|
|
|
804 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
805 "<KBD>"
|
|
|
806 'hm--html-insert-end-tag
|
|
|
807 "</KBD>"))
|
|
|
808
|
|
|
809
|
|
0
|
810 (defun hm--html-add-keyboard-to-region ()
|
|
|
811 "Adds the HTML tags for Keyboard to the region."
|
|
|
812 (interactive)
|
|
|
813 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
814 "<KBD>"
|
|
|
815 'hm--html-insert-end-tag
|
|
|
816 "</KBD>"))
|
|
|
817
|
|
|
818
|
|
2
|
819 (defun hm--html-add-sample ()
|
|
|
820 "Adds the HTML tags for Sample."
|
|
|
821 (interactive)
|
|
|
822 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
823 "<SAMP>"
|
|
|
824 'hm--html-insert-end-tag
|
|
|
825 "</SAMP>"))
|
|
|
826
|
|
0
|
827 (defun hm--html-add-sample-to-region ()
|
|
|
828 "Adds the HTML tags for Sample to the region."
|
|
|
829 (interactive)
|
|
|
830 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
831 "<SAMP>"
|
|
|
832 'hm--html-insert-end-tag
|
|
|
833 "</SAMP>"))
|
|
|
834
|
|
|
835
|
|
2
|
836 (defun hm--html-add-strong ()
|
|
|
837 "Adds the HTML tags for Strong."
|
|
|
838 (interactive)
|
|
|
839 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
840 "<STRONG>"
|
|
|
841 'hm--html-insert-end-tag
|
|
|
842 "</STRONG>"))
|
|
|
843
|
|
|
844
|
|
0
|
845 (defun hm--html-add-strong-to-region ()
|
|
|
846 "Adds the HTML tags for Strong to the region."
|
|
|
847 (interactive)
|
|
|
848 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
849 "<STRONG>"
|
|
|
850 'hm--html-insert-end-tag
|
|
|
851 "</STRONG>"))
|
|
|
852
|
|
|
853
|
|
2
|
854 (defun hm--html-add-variable ()
|
|
|
855 "Adds the HTML tags for Variable."
|
|
|
856 (interactive)
|
|
|
857 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
858 "<VAR>"
|
|
|
859 'hm--html-insert-end-tag
|
|
|
860 "</VAR>"))
|
|
|
861
|
|
0
|
862 (defun hm--html-add-variable-to-region ()
|
|
|
863 "Adds the HTML tags for Variable to the region."
|
|
|
864 (interactive)
|
|
|
865 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
866 "<VAR>"
|
|
|
867 'hm--html-insert-end-tag
|
|
|
868 "</VAR>"))
|
|
|
869
|
|
|
870
|
|
|
871 (defun hm--html-add-comment ()
|
|
|
872 "Adds the HTML tags for Comment at the point in the current buffer."
|
|
|
873 (interactive)
|
|
|
874 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
875 "<!-- "
|
|
|
876 'hm--html-insert-end-tag
|
|
|
877 " -->"))
|
|
|
878
|
|
|
879
|
|
|
880 (defun hm--html-add-comment-to-region ()
|
|
|
881 "Adds the HTML tags for Comment to the region."
|
|
|
882 (interactive)
|
|
|
883 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
884 "<!-- "
|
|
|
885 'hm--html-insert-end-tag
|
|
|
886 " -->"))
|
|
|
887
|
|
|
888
|
|
100
|
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
|
|
0
|
906
|
|
|
907 (defun hm--html-add-preformated ()
|
|
|
908 "Adds the HTML tags for preformated text at the point in the current buffer."
|
|
|
909 (interactive)
|
|
|
910 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
911 "<PRE>"
|
|
|
912 'hm--html-insert-end-tag-with-newline
|
|
|
913 "</PRE>"))
|
|
|
914
|
|
|
915
|
|
|
916 (defun hm--html-add-preformated-to-region ()
|
|
|
917 "Adds the HTML tags for preformated text to the region."
|
|
|
918 (interactive)
|
|
|
919 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
920 "<PRE>"
|
|
|
921 'hm--html-insert-end-tag-with-newline
|
|
|
922 "</PRE>"))
|
|
|
923
|
|
|
924
|
|
70
|
925 (defun hm--html-add-plaintext ()
|
|
|
926 "Adds the HTML tags for plaintext."
|
|
|
927 (interactive)
|
|
|
928 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
929 "<XMP>"
|
|
|
930 'hm--html-insert-end-tag-with-newline
|
|
|
931 "</XMP>"))
|
|
|
932
|
|
|
933
|
|
|
934 (defun hm--html-add-plaintext-to-region ()
|
|
|
935 "Adds the HTML tags for plaintext to the region."
|
|
|
936 (interactive)
|
|
|
937 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
938 "<XMP>"
|
|
|
939 'hm--html-insert-end-tag-with-newline
|
|
|
940 "</XMP>"))
|
|
|
941
|
|
|
942
|
|
2
|
943 (defun hm--html-add-blockquote ()
|
|
|
944 "Adds the HTML tags for blockquote."
|
|
|
945 (interactive)
|
|
|
946 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
947 "<BLOCKQUOTE>"
|
|
|
948 'hm--html-insert-end-tag-with-newline
|
|
|
949 "</BLOCKQUOTE>"))
|
|
|
950
|
|
|
951
|
|
0
|
952 (defun hm--html-add-blockquote-to-region ()
|
|
|
953 "Adds the HTML tags for blockquote to the region."
|
|
|
954 (interactive)
|
|
|
955 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
956 "<BLOCKQUOTE>"
|
|
|
957 'hm--html-insert-end-tag-with-newline
|
|
|
958 "</BLOCKQUOTE>"))
|
|
|
959
|
|
70
|
960 (defun hm--html-add-abstract ()
|
|
|
961 "Adds the HTML tags for abstract text at the point in the current buffer."
|
|
0
|
962 (interactive)
|
|
|
963 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
70
|
964 "<ABSTRACT>"
|
|
0
|
965 'hm--html-insert-end-tag-with-newline
|
|
70
|
966 "</ABSTRACT>"))
|
|
|
967
|
|
|
968
|
|
|
969 (defun hm--html-add-abstract-to-region ()
|
|
|
970 "Adds the HTML tags for abstract text to the region."
|
|
0
|
971 (interactive)
|
|
|
972 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
70
|
973 "<ABSTRACT>"
|
|
0
|
974 'hm--html-insert-end-tag-with-newline
|
|
70
|
975 "</ABSTRACT>"))
|
|
|
976
|
|
|
977
|
|
0
|
978
|
|
|
979 (defun hm--html-add-strikethru ()
|
|
|
980 "Adds the HTML tags for Strikethru at the point in the current buffer."
|
|
|
981 (interactive)
|
|
|
982 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
100
|
983 "<STRIKE>"
|
|
0
|
984 'hm--html-insert-end-tag
|
|
100
|
985 "</STRIKE>"))
|
|
0
|
986
|
|
|
987
|
|
|
988 (defun hm--html-add-strikethru-to-region ()
|
|
|
989 "Adds the HTML tags for Strikethru to the region."
|
|
|
990 (interactive)
|
|
|
991 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
70
|
992 "<S>"
|
|
0
|
993 'hm--html-insert-end-tag
|
|
70
|
994 "</S>"))
|
|
0
|
995
|
|
|
996
|
|
|
997 (defun hm--html-add-superscript ()
|
|
|
998 "Adds the HTML tags for Superscript at the point in the current buffer."
|
|
|
999 (interactive)
|
|
|
1000 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1001 "<SUP>"
|
|
|
1002 'hm--html-insert-end-tag
|
|
|
1003 "</SUP>"))
|
|
|
1004
|
|
|
1005
|
|
|
1006 (defun hm--html-add-superscript-to-region ()
|
|
|
1007 "Adds the HTML tags for Superscript to the region."
|
|
|
1008 (interactive)
|
|
|
1009 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1010 "<SUP>"
|
|
|
1011 'hm--html-insert-end-tag
|
|
|
1012 "</SUP>"))
|
|
|
1013
|
|
|
1014
|
|
|
1015 (defun hm--html-add-subscript ()
|
|
|
1016 "Adds the HTML tags for Subscript at the point in the current buffer."
|
|
|
1017 (interactive)
|
|
|
1018 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1019 "<SUB>"
|
|
|
1020 'hm--html-insert-end-tag
|
|
|
1021 "</SUB>"))
|
|
|
1022
|
|
|
1023
|
|
|
1024 (defun hm--html-add-subscript-to-region ()
|
|
|
1025 "Adds the HTML tags for Subscript to the region."
|
|
|
1026 (interactive)
|
|
|
1027 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1028 "<SUB>"
|
|
|
1029 'hm--html-insert-end-tag
|
|
|
1030 "</SUB>"))
|
|
|
1031
|
|
|
1032
|
|
70
|
1033 (defun hm--html-add-quote ()
|
|
|
1034 "Adds the HTML tags for Quote at the point in the current buffer."
|
|
|
1035 (interactive)
|
|
|
1036 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1037 "<Q>"
|
|
|
1038 'hm--html-insert-end-tag
|
|
|
1039 "</Q>"))
|
|
|
1040
|
|
|
1041
|
|
|
1042 (defun hm--html-add-quote-to-region ()
|
|
|
1043 "Adds the HTML tags for Quote to the region."
|
|
|
1044 (interactive)
|
|
|
1045 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1046 "<Q>"
|
|
|
1047 'hm--html-insert-end-tag
|
|
|
1048 "</Q>"))
|
|
|
1049
|
|
|
1050
|
|
|
1051 (defun hm--html-add-person ()
|
|
|
1052 "Adds the HTML tags for Person at the point in the current buffer."
|
|
|
1053 (interactive)
|
|
|
1054 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1055 "<PERSON>"
|
|
|
1056 'hm--html-insert-end-tag
|
|
|
1057 "</PERSON>"))
|
|
|
1058
|
|
|
1059
|
|
|
1060 (defun hm--html-add-person-to-region ()
|
|
|
1061 "Adds the HTML tags for Person to the region."
|
|
|
1062 (interactive)
|
|
|
1063 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1064 "<PERSON>"
|
|
|
1065 'hm--html-insert-end-tag
|
|
|
1066 "</PERSON>"))
|
|
|
1067
|
|
|
1068
|
|
|
1069 (defun hm--html-add-instance ()
|
|
|
1070 "Adds the HTML tags for Instance at the point in the current buffer."
|
|
|
1071 (interactive)
|
|
|
1072 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1073 "<INS>"
|
|
|
1074 'hm--html-insert-end-tag
|
|
|
1075 "</INS>"))
|
|
|
1076
|
|
|
1077
|
|
|
1078 (defun hm--html-add-instance-to-region ()
|
|
|
1079 "Adds the HTML tags for Instance to the region."
|
|
|
1080 (interactive)
|
|
|
1081 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1082 "<INS>"
|
|
|
1083 'hm--html-insert-end-tag
|
|
|
1084 "</INS>"))
|
|
|
1085
|
|
|
1086
|
|
0
|
1087 (defun hm--html-add-option ()
|
|
|
1088 "Adds the HTML tags for Option at the point in the current buffer."
|
|
|
1089 (interactive)
|
|
|
1090 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1091 "<OPT>"
|
|
|
1092 'hm--html-insert-end-tag
|
|
|
1093 "</OPT>"))
|
|
|
1094
|
|
|
1095
|
|
|
1096 (defun hm--html-add-option-to-region ()
|
|
|
1097 "Adds the HTML tags for Option to the region."
|
|
|
1098 (interactive)
|
|
|
1099 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1100 "<OPT>"
|
|
|
1101 'hm--html-insert-end-tag
|
|
|
1102 "</OPT>"))
|
|
|
1103
|
|
|
1104
|
|
70
|
1105 (defun hm--html-add-publication ()
|
|
|
1106 "Adds the HTML tags for Publication at the point in the current buffer."
|
|
|
1107 (interactive)
|
|
|
1108 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1109 "<PUB>"
|
|
|
1110 'hm--html-insert-end-tag
|
|
|
1111 "</PUB>"))
|
|
|
1112
|
|
|
1113
|
|
|
1114 (defun hm--html-add-publication-to-region ()
|
|
|
1115 "Adds the HTML tags for Publication to the region."
|
|
|
1116 (interactive)
|
|
|
1117 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1118 "<PUB>"
|
|
|
1119 'hm--html-insert-end-tag
|
|
|
1120 "</PUB>"))
|
|
|
1121
|
|
|
1122
|
|
|
1123 (defun hm--html-add-author ()
|
|
|
1124 "Adds the HTML tags for Author at the point in the current buffer."
|
|
|
1125 (interactive)
|
|
|
1126 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1127 "<AUTHOR>"
|
|
|
1128 'hm--html-insert-end-tag
|
|
|
1129 "</AUTHOR>"))
|
|
|
1130
|
|
|
1131
|
|
|
1132 (defun hm--html-add-author-to-region ()
|
|
|
1133 "Adds the HTML tags for Author to the region."
|
|
|
1134 (interactive)
|
|
|
1135 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1136 "<AUTHOR>"
|
|
|
1137 'hm--html-insert-end-tag
|
|
|
1138 "</AUTHOR>"))
|
|
|
1139
|
|
|
1140
|
|
|
1141 (defun hm--html-add-editor ()
|
|
|
1142 "Adds the HTML tags for Editor at the point in the current buffer."
|
|
|
1143 (interactive)
|
|
|
1144 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1145 "<EDITOR>"
|
|
|
1146 'hm--html-insert-end-tag
|
|
|
1147 "</EDITOR>"))
|
|
|
1148
|
|
|
1149
|
|
|
1150 (defun hm--html-add-editor-to-region ()
|
|
|
1151 "Adds the HTML tags for Editor to the region."
|
|
|
1152 (interactive)
|
|
|
1153 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1154 "<EDITOR>"
|
|
|
1155 'hm--html-insert-end-tag
|
|
|
1156 "</EDITOR>"))
|
|
|
1157
|
|
|
1158
|
|
|
1159 (defun hm--html-add-credits ()
|
|
|
1160 "Adds the HTML tags for Credits at the point in the current buffer."
|
|
|
1161 (interactive)
|
|
|
1162 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1163 "<CREDITS>"
|
|
|
1164 'hm--html-insert-end-tag
|
|
|
1165 "</CREDITS>"))
|
|
|
1166
|
|
|
1167
|
|
|
1168 (defun hm--html-add-credits-to-region ()
|
|
|
1169 "Adds the HTML tags for Credits to the region."
|
|
|
1170 (interactive)
|
|
|
1171 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1172 "<CREDITS>"
|
|
|
1173 'hm--html-insert-end-tag
|
|
|
1174 "</CREDITS>"))
|
|
|
1175
|
|
|
1176
|
|
|
1177 (defun hm--html-add-copyright ()
|
|
|
1178 "Adds the HTML tags for Copyright at the point in the current buffer."
|
|
|
1179 (interactive)
|
|
|
1180 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1181 "<COPYRIGHT>"
|
|
|
1182 'hm--html-insert-end-tag
|
|
|
1183 "</COPYRIGHT>"))
|
|
|
1184
|
|
|
1185
|
|
|
1186 (defun hm--html-add-copyright-to-region ()
|
|
|
1187 "Adds the HTML tags for Copyright to the region."
|
|
|
1188 (interactive)
|
|
|
1189 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1190 "<COPYRIGHT>"
|
|
|
1191 'hm--html-insert-end-tag
|
|
|
1192 "</COPYRIGHT>"))
|
|
|
1193
|
|
|
1194
|
|
|
1195 (defun hm--html-add-isbn ()
|
|
|
1196 "Adds the HTML tags for ISBN at the point in the current buffer."
|
|
|
1197 (interactive)
|
|
|
1198 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1199 "<ISBN>"
|
|
|
1200 'hm--html-insert-end-tag
|
|
|
1201 "</ISBN>"))
|
|
|
1202
|
|
|
1203
|
|
|
1204 (defun hm--html-add-isbn-to-region ()
|
|
|
1205 "Adds the HTML tags for ISBN to the region."
|
|
|
1206 (interactive)
|
|
|
1207 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1208 "<ISBN>"
|
|
|
1209 'hm--html-insert-end-tag
|
|
|
1210 "</ISBN>"))
|
|
|
1211
|
|
|
1212
|
|
|
1213 (defun hm--html-add-acronym ()
|
|
|
1214 "Adds the HTML tags for Acronym at the point in the current buffer."
|
|
|
1215 (interactive)
|
|
|
1216 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1217 "<ACRONYM>"
|
|
|
1218 'hm--html-insert-end-tag
|
|
|
1219 "</ACRONYM>"))
|
|
|
1220
|
|
|
1221
|
|
|
1222 (defun hm--html-add-acronym-to-region ()
|
|
|
1223 "Adds the HTML tags for Acronym to the region."
|
|
|
1224 (interactive)
|
|
|
1225 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1226 "<ACRONYM>"
|
|
|
1227 'hm--html-insert-end-tag
|
|
|
1228 "</ACRONYM>"))
|
|
|
1229
|
|
|
1230
|
|
|
1231 (defun hm--html-add-abbrevation ()
|
|
|
1232 "Adds the HTML tags for Abbrevation at the point in the current buffer."
|
|
|
1233 (interactive)
|
|
|
1234 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1235 "<ABBREV>"
|
|
|
1236 'hm--html-insert-end-tag
|
|
|
1237 "</ABBREV>"))
|
|
|
1238
|
|
|
1239
|
|
|
1240 (defun hm--html-add-abbrev-to-region ()
|
|
|
1241 "Adds the HTML tags for Abbrev to the region."
|
|
|
1242 (interactive)
|
|
|
1243 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1244 "<ABBREV>"
|
|
|
1245 'hm--html-insert-end-tag
|
|
|
1246 "</ABBREV>"))
|
|
|
1247
|
|
|
1248
|
|
|
1249 (defun hm--html-add-command ()
|
|
|
1250 "Adds the HTML tags for Command at the point in the current buffer."
|
|
|
1251 (interactive)
|
|
|
1252 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1253 "<CMD>"
|
|
|
1254 'hm--html-insert-end-tag
|
|
|
1255 "</CMD>"))
|
|
|
1256
|
|
|
1257
|
|
|
1258 (defun hm--html-add-command-to-region ()
|
|
|
1259 "Adds the HTML tags for Command to the region."
|
|
|
1260 (interactive)
|
|
|
1261 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1262 "<CMD>"
|
|
|
1263 'hm--html-insert-end-tag
|
|
|
1264 "</CMD>"))
|
|
|
1265
|
|
|
1266
|
|
|
1267 (defun hm--html-add-argument ()
|
|
|
1268 "Adds the HTML tags for Argument at the point in the current buffer."
|
|
|
1269 (interactive)
|
|
|
1270 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1271 "<ARG>"
|
|
|
1272 'hm--html-insert-end-tag
|
|
|
1273 "</ARG>"))
|
|
|
1274
|
|
|
1275
|
|
|
1276 (defun hm--html-add-argument-to-region ()
|
|
|
1277 "Adds the HTML tags for Argument to the region."
|
|
|
1278 (interactive)
|
|
|
1279 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1280 "<ARG>"
|
|
|
1281 'hm--html-insert-end-tag
|
|
|
1282 "</ARG>"))
|
|
|
1283
|
|
|
1284
|
|
|
1285 (defun hm--html-add-literature ()
|
|
|
1286 "Adds the HTML tags for Literature at the point in the current buffer."
|
|
|
1287 (interactive)
|
|
|
1288 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1289 "<LIT>"
|
|
|
1290 'hm--html-insert-end-tag
|
|
|
1291 "</LIT>"))
|
|
|
1292
|
|
|
1293
|
|
|
1294 (defun hm--html-add-literature-to-region ()
|
|
|
1295 "Adds the HTML tags for Literature to the region."
|
|
|
1296 (interactive)
|
|
|
1297 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1298 "<LIT>"
|
|
|
1299 'hm--html-insert-end-tag
|
|
|
1300 "</LIT>"))
|
|
|
1301
|
|
|
1302
|
|
|
1303 (defun hm--html-add-footnote ()
|
|
|
1304 "Adds the HTML tags for Footnote at the point in the current buffer."
|
|
|
1305 (interactive)
|
|
|
1306 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1307 "<FOOTNOTE>"
|
|
|
1308 'hm--html-insert-end-tag
|
|
|
1309 "</FOOTNOTE>"))
|
|
|
1310
|
|
|
1311
|
|
|
1312 (defun hm--html-add-footnote-to-region ()
|
|
|
1313 "Adds the HTML tags for Footnote to the region."
|
|
|
1314 (interactive)
|
|
|
1315 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1316 "<FOOTNOTE>"
|
|
|
1317 'hm--html-insert-end-tag
|
|
|
1318 "</FOOTNOTE>"))
|
|
|
1319
|
|
|
1320
|
|
|
1321 (defun hm--html-add-margin ()
|
|
|
1322 "Adds the HTML tags for Margin at the point in the current buffer."
|
|
|
1323 (interactive)
|
|
|
1324 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1325 "<MARGIN>"
|
|
|
1326 'hm--html-insert-end-tag
|
|
|
1327 "</MARGIN>"))
|
|
|
1328
|
|
|
1329
|
|
|
1330 (defun hm--html-add-margin-to-region ()
|
|
|
1331 "Adds the HTML tags for Margin to the region."
|
|
|
1332 (interactive)
|
|
|
1333 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1334 "<MARGIN>"
|
|
|
1335 'hm--html-insert-end-tag
|
|
|
1336 "</MARGIN>"))
|
|
|
1337
|
|
100
|
1338 (defun hm--html-read-font-size (&optional only-absolute-size)
|
|
|
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>"))
|
|
0
|
1409
|
|
|
1410
|
|
|
1411 ;;; Lists
|
|
|
1412
|
|
|
1413
|
|
70
|
1414 (defun hm--html-add-listing ()
|
|
|
1415 "Adds the HTML tags for listing."
|
|
|
1416 (interactive)
|
|
|
1417 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
1418 "<LISTING>"
|
|
|
1419 'hm--html-insert-end-tag-with-newline
|
|
|
1420 "</LISTING>"))
|
|
|
1421
|
|
|
1422
|
|
|
1423 (defun hm--html-add-listing-to-region ()
|
|
|
1424 "Adds the HTML tags for listing to the region."
|
|
|
1425 (interactive)
|
|
|
1426 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
1427 "<LISTING>"
|
|
|
1428 'hm--html-insert-end-tag-with-newline
|
|
|
1429 "</LISTING>"))
|
|
|
1430
|
|
2
|
1431 (defun hm--html-add-center ()
|
|
|
1432 "Adds the HTML tags for center at the current point."
|
|
|
1433 (interactive)
|
|
|
1434 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
1435 "<CENTER>"
|
|
|
1436 'hm--html-insert-end-tag-with-newline
|
|
|
1437 "</CENTER>"))
|
|
|
1438
|
|
|
1439 (defun hm--html-add-center-to-region ()
|
|
|
1440 "Adds the HTML tags for center to the region."
|
|
|
1441 (interactive)
|
|
|
1442 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
1443 "<CENTER>"
|
|
|
1444 'hm--html-insert-end-tag-with-newline
|
|
|
1445 "</CENTER>"))
|
|
0
|
1446
|
|
100
|
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
|
|
|
1489
|
|
0
|
1490 (defun hm--html-add-numberlist ()
|
|
|
1491 "Adds the HTML tags for a numbered list at the point in the current buffer."
|
|
|
1492 (interactive)
|
|
|
1493 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
1494 "<OL>"
|
|
|
1495 'hm--html-insert-end-tag-with-newline
|
|
|
1496 "</OL>"
|
|
|
1497 'hm--html-insert-start-tag
|
|
98
|
1498 "<LI> "
|
|
|
1499 'hm--html-insert-end-tag
|
|
|
1500 " </LI>"))
|
|
0
|
1501
|
|
|
1502 (defun hm--html-add-numberlist-to-region ()
|
|
|
1503 "Adds the HTML tags for a numbered list to the region."
|
|
|
1504 (interactive)
|
|
|
1505 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
1506 "<OL>"
|
|
|
1507 'hm--html-insert-end-tag-with-newline
|
|
98
|
1508 "</OL>"))
|
|
0
|
1509
|
|
|
1510
|
|
|
1511 (defun hm--html-add-directory-list ()
|
|
|
1512 "Adds the HTML tags for a directory list at the point in the current buffer."
|
|
|
1513 (interactive)
|
|
|
1514 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
1515 "<DIR>"
|
|
|
1516 'hm--html-insert-end-tag-with-newline
|
|
|
1517 "</DIR>"
|
|
|
1518 'hm--html-insert-start-tag
|
|
98
|
1519 "<LI> "
|
|
|
1520 'hm--html-insert-end-tag
|
|
|
1521 " </LI>"))
|
|
0
|
1522
|
|
|
1523 (defun hm--html-add-directorylist-to-region ()
|
|
|
1524 "Adds the HTML tags for a directory list to the region."
|
|
|
1525 (interactive)
|
|
|
1526 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
1527 "<DIR>"
|
|
|
1528 'hm--html-insert-end-tag-with-newline
|
|
98
|
1529 "</DIR>"))
|
|
0
|
1530
|
|
|
1531
|
|
2
|
1532 (defun hm--html-add-list ()
|
|
|
1533 "Adds the HTML tags for a (unnumbered) list to the region."
|
|
|
1534 (interactive)
|
|
|
1535 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
1536 "<UL>"
|
|
|
1537 'hm--html-insert-end-tag-with-newline
|
|
|
1538 "</UL>"
|
|
|
1539 'hm--html-insert-start-tag
|
|
98
|
1540 "<LI> "
|
|
|
1541 'hm--html-insert-end-tag
|
|
|
1542 " </LI>"))
|
|
2
|
1543
|
|
|
1544
|
|
0
|
1545 (defun hm--html-add-list-to-region ()
|
|
|
1546 "Adds the HTML tags for a (unnumbered) list to the region."
|
|
|
1547 (interactive)
|
|
|
1548 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
1549 "<UL>"
|
|
|
1550 'hm--html-insert-end-tag-with-newline
|
|
98
|
1551 "</UL>"))
|
|
2
|
1552
|
|
|
1553
|
|
|
1554 (defun hm--html-add-menu ()
|
|
|
1555 "Adds the HTML tags for a menu."
|
|
|
1556 (interactive)
|
|
|
1557 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
1558 "<MENU>"
|
|
|
1559 'hm--html-insert-end-tag-with-newline
|
|
|
1560 "</MENU>"
|
|
|
1561 'hm--html-insert-start-tag
|
|
|
1562 "<LI> "
|
|
|
1563 'hm--html-insert-end-tag
|
|
|
1564 " </LI>"))
|
|
|
1565
|
|
|
1566
|
|
0
|
1567 (defun hm--html-add-menu-to-region ()
|
|
|
1568 "Adds the HTML tags for a menu to the region."
|
|
|
1569 (interactive)
|
|
|
1570 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
1571 "<MENU>"
|
|
|
1572 'hm--html-insert-end-tag-with-newline
|
|
2
|
1573 "</MENU>"))
|
|
|
1574
|
|
|
1575
|
|
|
1576 (defun hm--html-add-description-title-and-entry ()
|
|
|
1577 "Adds a definition title and entry.
|
|
|
1578 Assumes we're at the end of a previous entry."
|
|
|
1579 (interactive)
|
|
|
1580 (hm--html-add-description-title)
|
|
98
|
1581 (let ((position (point))
|
|
|
1582 (case-fold-search t))
|
|
|
1583 (search-forward "</dt>")
|
|
|
1584 (hm--html-add-description-entry)
|
|
2
|
1585 (goto-char position)))
|
|
|
1586
|
|
|
1587
|
|
|
1588 (defun hm--html-add-description-list ()
|
|
|
1589 "Adds the HTML tags for a description list.
|
|
|
1590 It also inserts a tag for the description title."
|
|
|
1591 (interactive)
|
|
|
1592 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
1593 "<DL>"
|
|
|
1594 'hm--html-insert-end-tag-with-newline
|
|
|
1595 "</DL>"
|
|
|
1596 'hm--html-insert-start-tag
|
|
|
1597 "<DT> "
|
|
|
1598 'hm--html-insert-end-tag
|
|
|
1599 " </DT>"))
|
|
|
1600
|
|
0
|
1601
|
|
|
1602 (defun hm--html-add-description-list-to-region ()
|
|
|
1603 "Adds the HTML tags for a description list to a region.
|
|
|
1604 It also inserts a tag for the description title."
|
|
|
1605 (interactive)
|
|
|
1606 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
1607 "<DL>"
|
|
|
1608 'hm--html-insert-end-tag-with-newline
|
|
2
|
1609 "</DL>"))
|
|
70
|
1610
|
|
|
1611 ; 'hm--html-insert-start-tag
|
|
|
1612 ; "<DT> "))
|
|
0
|
1613
|
|
|
1614
|
|
|
1615 (defun hm--html-add-description-title ()
|
|
2
|
1616 "Adds the HTML tags for a description title at current point in the buffer."
|
|
|
1617 (interactive)
|
|
|
1618 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline
|
|
|
1619 "<DT> "
|
|
|
1620 'hm--html-insert-end-tag
|
|
|
1621 " </DT>"))
|
|
|
1622
|
|
|
1623
|
|
|
1624 (defun hm--html-add-description-title-to-region ()
|
|
|
1625 "Adds the HTML tags for a description title to the region in the buffer."
|
|
|
1626 (interactive)
|
|
|
1627 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1628 "<DT> "
|
|
|
1629 'hm--html-insert-end-tag
|
|
|
1630 " </DT>"))
|
|
|
1631
|
|
|
1632
|
|
|
1633 (defun hm--html-add-description-entry ()
|
|
|
1634 "Adds the HTML tags for a description entry at current point in the buffer."
|
|
0
|
1635 (interactive)
|
|
|
1636 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline
|
|
2
|
1637 "<DD> "
|
|
|
1638 'hm--html-insert-end-tag
|
|
|
1639 " </DD>"))
|
|
|
1640
|
|
|
1641
|
|
|
1642 (defun hm--html-add-description-entry-to-region ()
|
|
|
1643 "Adds the HTML tags for a description entry to the region in the buffer."
|
|
0
|
1644 (interactive)
|
|
2
|
1645 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1646 "<DD> "
|
|
|
1647 'hm--html-insert-end-tag
|
|
|
1648 " </DD>"))
|
|
|
1649
|
|
|
1650
|
|
|
1651 (defun hm--html-add-address ()
|
|
|
1652 "Adds the HTML tags for an address."
|
|
|
1653 (interactive)
|
|
|
1654 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1655 "<ADDRESS>"
|
|
|
1656 'hm--html-insert-end-tag
|
|
|
1657 "</ADDRESS>"))
|
|
0
|
1658
|
|
|
1659 (defun hm--html-add-address-to-region ()
|
|
|
1660 "Adds the HTML tags for an address to the region"
|
|
|
1661 (interactive)
|
|
|
1662 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
2
|
1663 "<ADDRESS>"
|
|
0
|
1664 'hm--html-insert-end-tag
|
|
2
|
1665 "</ADDRESS>"))
|
|
0
|
1666
|
|
|
1667
|
|
|
1668 (defvar hm--html-signature-reference-name "Signature"
|
|
|
1669 "The signature reference name.")
|
|
|
1670
|
|
|
1671
|
|
|
1672 (defun hm--html-make-signature-link-string (signature-file-name)
|
|
|
1673 "Returns a string which is a link to a signature file."
|
|
|
1674 (concat
|
|
100
|
1675 "<A NAME=\""
|
|
0
|
1676 hm--html-signature-reference-name
|
|
100
|
1677 "\"\nHREF=\""
|
|
0
|
1678 signature-file-name
|
|
|
1679 "\">"))
|
|
100
|
1680
|
|
0
|
1681
|
|
|
1682 (defun hm--html-delete-old-signature ()
|
|
|
1683 "Searches for the old signature and deletes it, if the user want it"
|
|
|
1684 (save-excursion
|
|
|
1685 (goto-char (point-min))
|
|
98
|
1686 (let ((case-fold-search t))
|
|
100
|
1687 (if (re-search-forward (concat "<address>[ \t\n]*"
|
|
|
1688 "<a[ \t\n]+name=[ \t\n]*\"?"
|
|
|
1689 hm--html-signature-reference-name
|
|
|
1690 "\"?[ \t\n]+href=[ \t\n]*\"")
|
|
|
1691 nil
|
|
|
1692 t)
|
|
98
|
1693 (let ((signature-start (match-beginning 0))
|
|
|
1694 (signature-end (progn
|
|
100
|
1695 (re-search-forward "</address>[ \t]*[\n]?"
|
|
|
1696 nil
|
|
|
1697 t)
|
|
98
|
1698 (point))))
|
|
100
|
1699 (when (yes-or-no-p "Delete the old signature (yes or no) ?")
|
|
|
1700 (delete-region signature-start signature-end)
|
|
|
1701 (hm--html-indent-line)))))))
|
|
0
|
1702
|
|
|
1703
|
|
|
1704 (defun hm--html-set-point-for-signature ()
|
|
|
1705 "Searches and sets the point for inserting the signature.
|
|
|
1706 It searches from the end to the beginning of the file. At first it
|
|
|
1707 tries to use the point before the </body> tag then the point before
|
|
|
1708 the </html> tag and the the end of the file."
|
|
|
1709 (goto-char (point-max))
|
|
98
|
1710 (let ((case-fold-search t))
|
|
|
1711 (cond ((search-backward "</body>" nil t)
|
|
|
1712 (end-of-line 0)
|
|
|
1713 (if (> (current-column) 0)
|
|
100
|
1714 (newline 1)))
|
|
98
|
1715 ((search-backward "</html>" nil t)
|
|
|
1716 (end-of-line 0)
|
|
|
1717 (if (> (current-column) 0)
|
|
|
1718 (newline 2)))
|
|
|
1719 ((> (current-column) 0)
|
|
|
1720 (newline 2))
|
|
|
1721 (t))))
|
|
0
|
1722
|
|
|
1723
|
|
|
1724 (defun hm--html-add-signature ()
|
|
|
1725 "Adds the owner's signature at the end of the buffer."
|
|
|
1726 (interactive)
|
|
|
1727 (if hm--html-signature-file
|
|
|
1728 (progn
|
|
|
1729 (if (not hm--html-username)
|
|
|
1730 (setq hm--html-username (user-full-name)))
|
|
|
1731 (save-excursion
|
|
|
1732 (hm--html-delete-old-signature)
|
|
|
1733 (hm--html-set-point-for-signature)
|
|
100
|
1734 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
1735 "<ADDRESS>"
|
|
0
|
1736 'hm--html-insert-end-tag
|
|
100
|
1737 "</A>\n</ADDRESS>"
|
|
0
|
1738 'hm--html-insert-start-tag
|
|
|
1739 (hm--html-make-signature-link-string
|
|
|
1740 hm--html-signature-file)
|
|
|
1741 )
|
|
|
1742 (insert hm--html-username)))
|
|
|
1743 (error "ERROR: Define your hm--html-signature-file first !")))
|
|
|
1744
|
|
|
1745
|
|
|
1746 (defun hm--html-add-header (size &optional header)
|
|
|
1747 "Adds the HTML tags for a header at the point in the current buffer."
|
|
|
1748 (interactive "nSize (1 .. 6; 1 biggest): ")
|
|
|
1749 (if (or (< size 1) (> size 6))
|
|
|
1750 (message "The size must be a number from 1 to 6 !")
|
|
|
1751 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1752 (format "<H%d>" size)
|
|
|
1753 'hm--html-insert-start-tag-with-newline
|
|
|
1754 (format "</H%d>" size))
|
|
|
1755 (if header
|
|
|
1756 (insert header))))
|
|
|
1757
|
|
|
1758
|
|
|
1759 (defun hm--html-add-header-to-region (size)
|
|
|
1760 "Adds the HTML tags for a header to the region.
|
|
|
1761 The parameter 'size' specifies the size of the header."
|
|
|
1762 (interactive "nSize (1 .. 6; 1 biggest): ")
|
|
|
1763 (if (or (< size 1) (> size 6))
|
|
|
1764 (message "The size must be a number from 1 to 6 !")
|
|
|
1765 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
1766 (format "<H%d>" size)
|
|
|
1767 'hm--html-insert-end-tag
|
|
|
1768 (format "</H%d>" size))))
|
|
|
1769
|
|
|
1770
|
|
|
1771 (defun hm--html-set-point-for-title ()
|
|
|
1772 "Searches and sets the point for inserting the HTML element title.
|
|
|
1773 The functions start at the beginning of the file and searches first
|
|
|
1774 for the HTML tag <ISINDEX>. If such a tag exists, the point is set to the
|
|
|
1775 position after the tag. If not, the function next searches for the
|
|
|
1776 tag <HEAD> and sets the point after the tag, if it exists, or searches for
|
|
|
1777 the tag <HTML>. If this tag exists, the point is set to the position after
|
|
|
1778 this tag or the beginning of the file otherwise."
|
|
|
1779 (goto-char (point-min))
|
|
98
|
1780 (let ((case-fold-search t))
|
|
100
|
1781 (cond ((search-forward-regexp "<isindex[^>]*>" nil t) (newline))
|
|
|
1782 ((search-forward-regexp "<head[^>]*>" nil t) (newline))
|
|
|
1783 ((search-forward-regexp "<html[^>]*>" nil t) (newline))
|
|
98
|
1784 (t))))
|
|
0
|
1785
|
|
|
1786
|
|
|
1787 (defun hm--html-add-title (title)
|
|
|
1788 "Adds the HTML tags for a title at the beginning of the buffer."
|
|
|
1789 (interactive "sTitle: ")
|
|
|
1790 (save-excursion
|
|
|
1791 (goto-char (point-min))
|
|
98
|
1792 (let ((case-fold-search t))
|
|
|
1793 (if (search-forward "<title>" nil t)
|
|
|
1794 (let ((point-after-start-tag (point)))
|
|
|
1795 (if (not (search-forward "</title>" nil t))
|
|
|
1796 nil
|
|
|
1797 (goto-char (- (point) 8))
|
|
|
1798 (delete-backward-char (- (point) point-after-start-tag))
|
|
|
1799 (let ((start (point)))
|
|
|
1800 (insert title " (" (hm--date) ")")
|
|
|
1801 (goto-char start))))
|
|
|
1802 ;; Noch kein <TITLE> im Buffer vorhanden
|
|
|
1803 (hm--html-set-point-for-title)
|
|
|
1804 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1805 "<TITLE>"
|
|
|
1806 'hm--html-insert-end-tag
|
|
|
1807 "</TITLE>"
|
|
|
1808 'insert
|
|
|
1809 (concat title " (" (hm--date) ")"))
|
|
|
1810 (forward-char 8)
|
|
|
1811 (newline 1)
|
|
|
1812 ))))
|
|
0
|
1813
|
|
|
1814
|
|
|
1815 (defun hm--html-add-title-to-region ()
|
|
|
1816 "Adds the HTML tags for a title to the region."
|
|
|
1817 (interactive)
|
|
98
|
1818 (let ((title (buffer-substring (region-beginning) (region-end)))
|
|
|
1819 (case-fold-search t))
|
|
0
|
1820 (save-excursion
|
|
|
1821 (goto-char (point-min))
|
|
|
1822 (if (search-forward "<title>" nil t)
|
|
|
1823 (let ((point-after-start-tag (point)))
|
|
|
1824 (if (not (search-forward "</title>" nil t))
|
|
|
1825 nil
|
|
|
1826 (goto-char (- (point) 8))
|
|
|
1827 (delete-backward-char (- (point) point-after-start-tag))
|
|
|
1828 (insert title " (" (hm--date) ")")))
|
|
|
1829 ;; Noch kein <TITLE> im Buffer vorhanden
|
|
|
1830 (hm--html-set-point-for-title)
|
|
|
1831 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
1832 "<TITLE>"
|
|
|
1833 'hm--html-insert-end-tag
|
|
|
1834 "</TITLE>"
|
|
|
1835 'insert
|
|
|
1836 (concat title " (" (hm--date) ")"))
|
|
|
1837 (forward-char 8)
|
|
|
1838 ;(newline 1)
|
|
|
1839 ))))
|
|
|
1840
|
|
|
1841
|
|
|
1842 (defun hm--html-add-html ()
|
|
|
1843 "Adds the HTML tags <HTML> and </HTML> in the buffer.
|
|
100
|
1844 The tag <HTML> will be inserted at the beginning (after the
|
|
|
1845 <!DOCTYPE ...>, if it is already there.) and </HTML> at the
|
|
0
|
1846 end of the file."
|
|
|
1847 (interactive)
|
|
98
|
1848 (let ((new-cursor-position nil)
|
|
|
1849 (case-fold-search t))
|
|
0
|
1850 (save-excursion
|
|
|
1851 (goto-char (point-min))
|
|
|
1852 (if (search-forward "<html>" nil t)
|
|
|
1853 (error "There is an old tag <HTML> in the current buffer !")
|
|
100
|
1854 (re-search-forward "<!DOCTYPE[^>]*>[ \t\n]*" nil t)
|
|
0
|
1855 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline "<HTML>")
|
|
|
1856 ; (newline 1)
|
|
|
1857 )
|
|
|
1858 (setq new-cursor-position (point))
|
|
|
1859 (goto-char (point-max))
|
|
|
1860 (if (search-backward "</html>" nil t)
|
|
|
1861 (error "There is an old tag </HTML> in the current buffer !")
|
|
|
1862 (newline 1)
|
|
|
1863 (hm--html-add-tags 'hm--html-insert-end-tag "</HTML>")))
|
|
|
1864 (goto-char new-cursor-position)))
|
|
|
1865
|
|
|
1866
|
|
|
1867 (defun hm--html-add-head ()
|
|
|
1868 "Adds the HTML tags <HEAD> and </HEAD> in the buffer.
|
|
100
|
1869 The tags will be inserted after <HTML> or at the beginning
|
|
|
1870 of the file after <DOCTYPE...> (if it is already there).
|
|
0
|
1871 The function also looks for the tags <BODY> and </TITLE>."
|
|
|
1872 (interactive)
|
|
98
|
1873 (let ((case-fold-search t))
|
|
0
|
1874 (goto-char (point-min))
|
|
100
|
1875 (re-search-forward "<!DOCTYPE[^>]*>[ \t\n]*" nil t)
|
|
0
|
1876 (if (search-forward "<html>" nil t)
|
|
|
1877 (if (search-forward "<head>" nil t)
|
|
|
1878 (error "There is an old tag <HEAD> in the current buffer !")
|
|
|
1879 (if (search-forward "</head>" nil t)
|
|
|
1880 (error "There is an old tag </HEAD> in the current buffer !")
|
|
|
1881 (newline 1))))
|
|
|
1882 (let ((start-tag-position (point)))
|
|
|
1883 (if (search-forward "<body>" nil t)
|
|
|
1884 (progn
|
|
|
1885 (forward-line 0)
|
|
|
1886 (forward-char -1)
|
|
|
1887 (if (= (point) (point-min))
|
|
|
1888 (progn
|
|
|
1889 (newline)
|
|
|
1890 (forward-line -1)))
|
|
|
1891 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline
|
|
|
1892 "</HEAD>")
|
|
|
1893 (goto-char start-tag-position)
|
|
|
1894 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
1895 "<HEAD>")
|
|
|
1896 )
|
|
|
1897 (if (search-forward "</title>" nil t)
|
|
|
1898 (progn
|
|
|
1899 (newline 1)
|
|
|
1900 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline
|
|
|
1901 "</HEAD>")
|
|
|
1902 (goto-char start-tag-position)
|
|
|
1903 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
1904 "<HEAD>"))
|
|
|
1905 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
1906 "<HEAD>"
|
|
|
1907 'hm--html-insert-end-tag-with-newline
|
|
98
|
1908 "</HEAD>"))))))
|
|
0
|
1909
|
|
|
1910
|
|
|
1911 (defun hm--html-add-head-to-region ()
|
|
|
1912 "Adds the HTML tags <HEAD> and </HEAD> to the region."
|
|
|
1913 (interactive)
|
|
|
1914 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
1915 "<HEAD>"
|
|
|
1916 'hm--html-insert-end-tag-with-newline
|
|
|
1917 "</HEAD>"))
|
|
|
1918
|
|
|
1919
|
|
|
1920 (defun hm--html-add-body ()
|
|
|
1921 "Adds the HTML tags <BODY> and </BODY> in the buffer.
|
|
|
1922 The tags will be inserted before </HTML> or at the end of the file."
|
|
|
1923 (interactive)
|
|
98
|
1924 (let ((case-fold-search t))
|
|
0
|
1925 (goto-char (point-max))
|
|
|
1926 (if (search-backward "</html>" nil t)
|
|
|
1927 (progn
|
|
|
1928 (if (search-backward "</body>" nil t)
|
|
|
1929 (error "There is an old tag </BODY> in the current buffer !")
|
|
|
1930 (if (search-backward "<body>" nil t)
|
|
|
1931 (error "There is an old tag <BODY> in the current buffer !")))
|
|
|
1932 (forward-char -1)))
|
|
100
|
1933 (let ((end-tag-position (set-marker (make-marker) (point))))
|
|
0
|
1934 (if (search-backward "</head>" nil t)
|
|
|
1935 (progn
|
|
|
1936 (forward-char 7)
|
|
|
1937 (newline 1)
|
|
|
1938 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
1939 "<BODY>")
|
|
|
1940 (let ((cursor-position (point)))
|
|
100
|
1941 (goto-char end-tag-position)
|
|
0
|
1942 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline
|
|
|
1943 "</BODY>")
|
|
|
1944 (goto-char cursor-position)
|
|
|
1945 ))
|
|
|
1946 (if (not (= (current-column) 0))
|
|
|
1947 (newline))
|
|
|
1948 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline "<BODY>"
|
|
98
|
1949 'hm--html-insert-end-tag-with-newline "</BODY>")))))
|
|
0
|
1950
|
|
|
1951
|
|
|
1952 (defun hm--html-add-body-to-region ()
|
|
|
1953 "Adds the HTML tags <BODY> and </BODY> to the region."
|
|
|
1954 (interactive)
|
|
|
1955 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
1956 "<BODY>"
|
|
|
1957 'hm--html-insert-end-tag-with-newline
|
|
|
1958 "</BODY>"))
|
|
|
1959
|
|
|
1960
|
|
|
1961 (defun hm--html-add-title-and-header (title)
|
|
|
1962 "Adds the HTML tags for a title and a header in the current buffer."
|
|
|
1963 (interactive "sTitle and Header String: ")
|
|
98
|
1964 (let ((case-fold-search t))
|
|
|
1965 (hm--html-add-title title)
|
|
|
1966 (save-excursion
|
|
|
1967 (goto-char (point-min))
|
|
|
1968 (search-forward "</title>" nil t)
|
|
|
1969 (if (search-forward "</head>" nil t)
|
|
|
1970 (progn
|
|
|
1971 (search-forward "<body>" nil t)
|
|
|
1972 (newline 1))
|
|
|
1973 (if (search-forward "<body>" nil t)
|
|
|
1974 (newline 1)
|
|
|
1975 (if (string= (what-line) "Line 1")
|
|
|
1976 (progn
|
|
|
1977 (end-of-line)
|
|
|
1978 (newline 1)))))
|
|
|
1979 (hm--html-add-header 1 title))))
|
|
0
|
1980
|
|
|
1981
|
|
|
1982 (defun hm--html-add-title-and-header-to-region ()
|
|
|
1983 "Adds the HTML tags for a title and a header to the region."
|
|
|
1984 (interactive)
|
|
|
1985 (let ((title (buffer-substring (region-beginning) (region-end))))
|
|
|
1986 (hm--html-add-header-to-region 1)
|
|
|
1987 (hm--html-add-title title)))
|
|
|
1988
|
|
|
1989
|
|
|
1990 (defun hm--html-add-full-html-frame (title)
|
|
|
1991 "Adds a full HTML frame to the current buffer.
|
|
|
1992 The frame consists of the elements html, head, body, title,
|
|
|
1993 header and the signature. The parameter TITLE specifies the
|
|
|
1994 title and the header of the document."
|
|
|
1995 (interactive "sTitle and Header String: ")
|
|
98
|
1996 (let ((case-fold-search t))
|
|
100
|
1997 (hm--html-add-doctype)
|
|
98
|
1998 (hm--html-add-html)
|
|
|
1999 (hm--html-add-head)
|
|
|
2000 (hm--html-add-body)
|
|
|
2001 (hm--html-add-title-and-header title)
|
|
|
2002 (if hm--html-signature-file
|
|
|
2003 (hm--html-add-signature))
|
|
|
2004 (goto-char (point-min))
|
|
|
2005 (search-forward "</h1>" nil t)
|
|
|
2006 (forward-line 1)
|
|
|
2007 (if hm--html-automatic-created-comment
|
|
|
2008 (hm--html-insert-created-comment))))
|
|
0
|
2009
|
|
|
2010
|
|
|
2011 (defun hm--html-add-full-html-frame-with-region ()
|
|
|
2012 "Adds a full HTML frame to the current buffer with the use of a region.
|
|
|
2013 The frame consists of the elements html, head, body, title,
|
|
|
2014 header and the signature. The function uses the region as
|
|
|
2015 the string for the title and the header of the document."
|
|
|
2016 (interactive)
|
|
|
2017 (hm--html-add-title-and-header-to-region)
|
|
100
|
2018 (hm--html-add-doctype)
|
|
0
|
2019 (hm--html-add-html)
|
|
|
2020 (hm--html-add-head)
|
|
|
2021 (hm--html-add-body)
|
|
|
2022 (hm--html-add-signature)
|
|
|
2023 (if hm--html-automatic-created-comment
|
|
|
2024 (hm--html-insert-created-comment)))
|
|
|
2025
|
|
|
2026
|
|
2
|
2027 (defun hm--html-add-link-target-to-region (name)
|
|
|
2028 "Adds the HTML tags for a link target to the region."
|
|
|
2029 (interactive "sName: ")
|
|
|
2030 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
2031 (concat "<A NAME=\"" name "\">")
|
|
|
2032 'hm--html-insert-end-tag
|
|
|
2033 "</A>"))
|
|
|
2034
|
|
0
|
2035 (defun hm--html-add-link-target (name)
|
|
|
2036 "Adds the HTML tags for a link target at point in the current buffer."
|
|
70
|
2037 ; (interactive "sName (or RET for numeric): ")
|
|
0
|
2038 (interactive "sName: ")
|
|
70
|
2039 ; (and (string= name "")
|
|
|
2040 ; (progn
|
|
|
2041 ; (setq html-link-counter (1+ html-link-counter))
|
|
|
2042 ; (setq name (format "%d" html-link-counter))))
|
|
0
|
2043 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
2044 (concat "<A NAME=\"" name "\">")
|
|
|
2045 'hm--html-insert-end-tag
|
|
|
2046 "</A>"))
|
|
|
2047
|
|
|
2048
|
|
|
2049 ;;; Functions which add links
|
|
|
2050
|
|
|
2051 (defun hm--html-mark-example (parameter-list)
|
|
|
2052 "Marks the example of the parameterlist in the current buffer.
|
|
|
2053 It returns the example extent."
|
|
98
|
2054 (let ((case-fold-search t))
|
|
|
2055 (if (hm--html-get-example-from-parameter-list parameter-list)
|
|
|
2056 (progn
|
|
|
2057 (search-forward (hm--html-get-example-from-parameter-list
|
|
|
2058 parameter-list))
|
|
|
2059 (let ((extent (make-extent (match-beginning 0)
|
|
|
2060 (match-end 0))))
|
|
|
2061 (set-extent-face extent 'hm--html-help-face)
|
|
|
2062 extent)))))
|
|
0
|
2063
|
|
|
2064
|
|
|
2065 (defun hm--html-unmark-example (extent)
|
|
|
2066 "Unmarks the example for the current question."
|
|
|
2067 (if extent
|
|
|
2068 (delete-extent extent)))
|
|
|
2069
|
|
70
|
2070 ; )
|
|
|
2071 ; ;; For the Emacs 19
|
|
|
2072 ; (defun hm--html-mark-example (parameter-list)
|
|
|
2073 ; "Marks the example of the parameterlist in the current buffer.
|
|
|
2074 ;It returns the example extent."
|
|
|
2075 ; (if (hm--html-get-example-from-parameter-list parameter-list)
|
|
|
2076 ; (progn
|
|
|
2077 ; (search-forward (hm--html-get-example-from-parameter-list
|
|
|
2078 ; parameter-list))
|
|
|
2079 ; (put-text-property (match-beginning 0)
|
|
|
2080 ; (match-end 0)
|
|
|
2081 ; 'face
|
|
|
2082 ; 'hm--html-help-face))))
|
|
|
2083 ;
|
|
|
2084 ;
|
|
|
2085 ; (defun hm--html-unmark-example (extent)
|
|
|
2086 ; "Unmarks the example for the current question."
|
|
|
2087 ; t))
|
|
|
2088
|
|
0
|
2089
|
|
|
2090 (defun hm--html-write-alist-in-buffer (alist)
|
|
|
2091 "The function writes the contents of the ALIST in the currentbuffer."
|
|
|
2092 (cond ((car alist)
|
|
|
2093 (insert (int-to-string (car (car alist))) ":\t" (cdr (car alist)))
|
|
|
2094 (newline)
|
|
|
2095 (hm--html-write-alist-in-buffer (cdr alist)))))
|
|
|
2096
|
|
|
2097
|
|
|
2098 (defun hm--html-select-directory (alist default)
|
|
|
2099 "The function selects one of the directories of the ALIST,
|
|
|
2100 or the DEFAULT or the 'default-directory' by number. See also the
|
|
|
2101 documentation of the function hm--html-read-filename."
|
|
|
2102 (if (or (string= default "") (not default))
|
|
|
2103 (setq default default-directory))
|
|
|
2104 (if alist
|
|
|
2105 (save-window-excursion
|
|
|
2106 (let ((buffername (generate-new-buffer "*html-directories*")))
|
|
|
2107 (set-buffer buffername)
|
|
|
2108 (insert "Select one of the following directories by number !")
|
|
|
2109 (newline)
|
|
|
2110 (insert "===================================================")
|
|
|
2111 (newline)
|
|
|
2112 (insert "0:\t" default)
|
|
|
2113 (newline)
|
|
|
2114 (hm--html-write-alist-in-buffer alist)
|
|
|
2115 (goto-char (point-min))
|
|
|
2116 (pop-to-buffer buffername))
|
|
|
2117 (let ((dirnumber (read-number
|
|
|
2118 "Select directory prefix by number: "
|
|
|
2119 t)))
|
|
|
2120 (kill-buffer "*html-directories*")
|
|
|
2121 (expand-file-name (or (cdr (assoc dirnumber alist)) default))))
|
|
|
2122 (expand-file-name default))
|
|
|
2123 )
|
|
|
2124
|
|
|
2125
|
|
|
2126 (defun hm--html-delete-wrong-path-prefix-1 (filename prefix-list)
|
|
|
2127 "The function deletes wrong path prefixes."
|
|
|
2128 (cond (prefix-list (if (string-match (car prefix-list) filename)
|
|
|
2129 (substring filename (match-end 0))
|
|
|
2130 (hm--html-delete-wrong-path-prefix-1 filename
|
|
|
2131 (cdr prefix-list)
|
|
|
2132 )))
|
|
|
2133 (t filename)))
|
|
|
2134
|
|
|
2135
|
|
|
2136 (defun hm--html-delete-wrong-path-prefix (filename)
|
|
|
2137 "The function deletes wrong path prefixes.
|
|
|
2138 The path prefixes are specified by the variable
|
|
|
2139 `hm--html-delete-wrong-path-prefix'."
|
|
|
2140 (if (not hm--html-delete-wrong-path-prefix)
|
|
|
2141 filename
|
|
|
2142 (if (listp hm--html-delete-wrong-path-prefix)
|
|
|
2143 (hm--html-delete-wrong-path-prefix-1 filename
|
|
|
2144 hm--html-delete-wrong-path-prefix)
|
|
|
2145 (hm--html-delete-wrong-path-prefix-1 filename
|
|
|
2146 (list
|
|
|
2147 hm--html-delete-wrong-path-prefix))
|
|
|
2148 )))
|
|
|
2149
|
|
|
2150
|
|
|
2151 (defun hm--html-read-filename (parameter-list)
|
|
|
2152 "The function reads a filename with its directory path,
|
|
|
2153 if PARAMETER-LIST is not nil. If the PARAMETER-LIST is nil, only an empty
|
|
|
2154 string will be returned.
|
|
|
2155 The PARAMETER-LIST consists of the following elements:
|
|
|
2156 PROMPT, ALIST, DEFAULT, REQUIRE-MATCH, EXAMPLE.
|
|
|
2157 If the ALIST is nil and DEFAULT is nil, then the function only reads
|
|
|
2158 a filename (without path). These precede the following.
|
|
|
2159 If the ALIST isn't nil, the function lists the contents of the ALIST
|
|
|
2160 in a buffer and reads a number from the minbuffer, which selects one
|
|
|
2161 of the directories (lines) of the buffer. Therefore the ALIST must look
|
|
|
2162 like the following alist:
|
|
|
2163 ((1 . \"/appl/gnu/\") (2 . \"/\"))
|
|
|
2164 If only ALIST is nil, or if you type a number which is not in the ALIST,
|
|
|
2165 the DEFAULT directory is selected. If the DEFAULT is nil or \"\" the
|
|
|
2166 'default-directory' is selected.
|
|
|
2167 After that the function reads the name of the file from the minibuffer.
|
|
|
2168 Therefore the PROMPT is printed in the minibuffer and the selected directory
|
|
|
2169 is taken as the start of the path of the file.
|
|
|
2170 If REQUIRE-MATCH is t, the filename with path must match an existing file."
|
|
|
2171 (if parameter-list
|
|
|
2172 (let ((marked-object (hm--html-mark-example parameter-list))
|
|
|
2173 (prompt (hm--html-get-prompt-from-parameter-list parameter-list))
|
|
|
2174 (alist (hm--html-get-alist-from-parameter-list parameter-list))
|
|
|
2175 (default (hm--html-get-default-from-parameter-list parameter-list))
|
|
|
2176 (require-match (hm--html-get-require-match-from-parameter-list
|
|
|
2177 parameter-list))
|
|
|
2178 (filename nil))
|
|
|
2179 (if (or alist default)
|
|
|
2180 (let ((directory (hm--html-select-directory alist default)))
|
|
|
2181 (setq filename (read-file-name prompt
|
|
|
2182 directory
|
|
|
2183 directory
|
|
|
2184 require-match
|
|
|
2185 nil)))
|
|
|
2186 (setq filename (read-file-name prompt
|
|
|
2187 ""
|
|
|
2188 ""
|
|
|
2189 require-match
|
|
|
2190 nil)))
|
|
|
2191 (hm--html-unmark-example marked-object)
|
|
|
2192 (hm--html-delete-wrong-path-prefix filename))
|
|
70
|
2193 ; (if (not hm--html-delete-wrong-path-prefix)
|
|
|
2194 ; filename
|
|
|
2195 ; (if (string-match hm--html-delete-wrong-path-prefix filename)
|
|
|
2196 ; (substring filename (match-end 0))
|
|
|
2197 ; filename)))
|
|
0
|
2198 ""))
|
|
|
2199
|
|
|
2200
|
|
|
2201 (defun hm--html-completing-read (parameter-list)
|
|
|
2202 "Reads a string with completing-read, if alist is non nil.
|
|
|
2203 The PARAMETER-LIST consists of the following elements:
|
|
|
2204 PROMPT, ALIST, DEFAULT, REQUIRE-MATCH, EXAMPLE.
|
|
|
2205 If ALIST is nil, it returns the DEFAULT, or if the DEFAULT is
|
|
|
2206 also nil it returns an empty string."
|
|
|
2207 (let ((marked-object (hm--html-mark-example parameter-list))
|
|
|
2208 (string
|
|
|
2209 (if (hm--html-get-alist-from-parameter-list parameter-list)
|
|
|
2210 (completing-read
|
|
|
2211 (hm--html-get-prompt-from-parameter-list parameter-list)
|
|
|
2212 (hm--html-get-alist-from-parameter-list parameter-list)
|
|
|
2213 nil
|
|
|
2214 (hm--html-get-require-match-from-parameter-list
|
|
|
2215 parameter-list)
|
|
|
2216 (hm--html-get-default-from-parameter-list
|
|
|
2217 parameter-list))
|
|
|
2218 (if (hm--html-get-default-from-parameter-list parameter-list)
|
|
|
2219 (hm--html-get-default-from-parameter-list parameter-list)
|
|
|
2220 ""))))
|
|
|
2221 (hm--html-unmark-example marked-object)
|
|
|
2222 string))
|
|
|
2223
|
|
|
2224
|
|
|
2225 (defvar hm--html-faces-exist nil)
|
|
|
2226
|
|
|
2227
|
|
|
2228 (defun hm--html-generate-help-buffer-faces ()
|
|
|
2229 "Generates faces for the add-link-help-buffer."
|
|
|
2230 (if (not (facep 'hm--html-help-face))
|
|
70
|
2231 ; (if (not hm--html-faces-exist)
|
|
0
|
2232 (progn
|
|
|
2233 (setq hm--html-faces-exist t)
|
|
|
2234 (make-face 'hm--html-help-face)
|
|
2
|
2235 (if hm--html-help-foreground
|
|
|
2236 (set-face-foreground 'hm--html-help-face hm--html-help-foreground))
|
|
|
2237 (if hm--html-help-background
|
|
|
2238 (set-face-background 'hm--html-help-face hm--html-help-background))
|
|
|
2239 (set-face-font 'hm--html-help-face hm--html-help-font)
|
|
0
|
2240 )))
|
|
|
2241
|
|
|
2242
|
|
|
2243 (defun hm--html-get-prompt-from-parameter-list (parameter-list)
|
|
|
2244 "Returns the prompt from the PARAMETER-LIST."
|
|
|
2245 (car parameter-list))
|
|
|
2246
|
|
|
2247
|
|
|
2248 (defun hm--html-get-alist-from-parameter-list (parameter-list)
|
|
|
2249 "Returns the alist from the PARAMETER-LIST."
|
|
|
2250 (car (cdr parameter-list)))
|
|
|
2251
|
|
|
2252
|
|
|
2253 (defun hm--html-get-default-from-parameter-list (parameter-list)
|
|
|
2254 "Returns the default from the PARAMETER-LIST."
|
|
|
2255 (car (cdr (cdr parameter-list))))
|
|
|
2256
|
|
|
2257
|
|
|
2258 (defun hm--html-get-require-match-from-parameter-list (parameter-list)
|
|
|
2259 "Returns the require-match from the PARAMETER-LIST."
|
|
|
2260 (car (cdr (cdr (cdr parameter-list)))))
|
|
|
2261
|
|
|
2262
|
|
|
2263 (defun hm--html-get-example-from-parameter-list (parameter-list)
|
|
|
2264 "Returns the example from the PARAMETER-LIST."
|
|
|
2265 (car (cdr (cdr (cdr (cdr parameter-list))))))
|
|
|
2266
|
|
|
2267
|
|
|
2268 (defun hm--html-get-anchor-seperator-from-parameter-list (parameter-list)
|
|
|
2269 "Returns the anchor-seperator from the PARAMETER-LIST."
|
|
|
2270 (car (cdr (cdr (cdr (cdr (cdr parameter-list)))))))
|
|
|
2271
|
|
|
2272
|
|
|
2273 (defun hm--html-generate-add-link-help-buffer (scheme-parameter-list
|
|
|
2274 host-name:port-parameter-list
|
|
|
2275 servername:port-parameter-list
|
|
|
2276 path+file-parameter-list
|
|
|
2277 anchor-parameter-list)
|
|
|
2278 "Generates and displays a help buffer with an example for adding a link."
|
|
|
2279 (let ((buffername (generate-new-buffer "*Link-Example*")))
|
|
|
2280 (pop-to-buffer buffername)
|
|
|
2281 (shrink-window (- (window-height) 5))
|
|
|
2282 (insert "Example:")
|
|
|
2283 (newline 2)
|
|
|
2284 (if (hm--html-get-example-from-parameter-list scheme-parameter-list)
|
|
|
2285 (progn
|
|
|
2286 (insert (hm--html-get-example-from-parameter-list
|
|
|
2287 scheme-parameter-list))
|
|
|
2288 (if (hm--html-get-example-from-parameter-list
|
|
|
2289 scheme-parameter-list)
|
|
|
2290 (progn
|
|
|
2291 (insert ":")
|
|
|
2292 (if (hm--html-get-example-from-parameter-list
|
|
|
2293 host-name:port-parameter-list)
|
|
|
2294 (insert "//"))))))
|
|
|
2295 (if (hm--html-get-example-from-parameter-list
|
|
|
2296 host-name:port-parameter-list)
|
|
|
2297 (progn
|
|
|
2298 (insert (hm--html-get-example-from-parameter-list
|
|
|
2299 host-name:port-parameter-list))
|
|
|
2300 (if (and (hm--html-get-example-from-parameter-list
|
|
|
2301 servername:port-parameter-list)
|
|
|
2302 (not (string= "/"
|
|
|
2303 (substring
|
|
|
2304 (hm--html-get-example-from-parameter-list
|
|
|
2305 servername:port-parameter-list)
|
|
|
2306 0
|
|
|
2307 1))))
|
|
|
2308 (insert "/"))))
|
|
|
2309 (if (hm--html-get-example-from-parameter-list
|
|
|
2310 servername:port-parameter-list)
|
|
|
2311 (progn
|
|
|
2312 (insert (hm--html-get-example-from-parameter-list
|
|
|
2313 servername:port-parameter-list))
|
|
|
2314 (if (hm--html-get-example-from-parameter-list
|
|
|
2315 path+file-parameter-list)
|
|
|
2316 (insert "/"))))
|
|
|
2317 (if (hm--html-get-example-from-parameter-list path+file-parameter-list)
|
|
|
2318 (progn
|
|
|
2319 (insert (hm--html-get-example-from-parameter-list
|
|
|
2320 path+file-parameter-list))))
|
|
|
2321 (if (hm--html-get-example-from-parameter-list anchor-parameter-list)
|
|
|
2322 (progn
|
|
|
2323 (insert (hm--html-get-anchor-seperator-from-parameter-list
|
|
|
2324 anchor-parameter-list))
|
|
|
2325 (insert (hm--html-get-example-from-parameter-list
|
|
|
2326 anchor-parameter-list))))
|
|
|
2327 (goto-char (point-min))
|
|
|
2328 buffername
|
|
|
2329 ))
|
|
|
2330
|
|
|
2331
|
|
|
2332 (defun hm--html-add-link (function-add-tags
|
|
|
2333 scheme-parameter-list
|
|
|
2334 host-name:port-parameter-list
|
|
|
2335 servername:port-parameter-list
|
|
|
2336 path+file-parameter-list
|
|
|
2337 anchor-parameter-list)
|
|
|
2338 "The function adds a link in the current buffer.
|
|
|
2339 The parameter FUNCTION-ADD-TAGS determines the function which adds the tag
|
|
|
2340 in the buffer (for example: 'hm--html-add-tags or
|
|
|
2341 'hm--html-add-tags-to-region).
|
|
|
2342 The parameters SCHEME-PARAMETER-LIST, HOST-NAME:PORT-PARAMETER-LIST,
|
|
|
2343 SERVERNAME:PORT-PARAMETER-LIST, PATH+FILE-PARAMETER-LIST and
|
|
|
2344 ANCHOR-PARAMETER-LIST are lists with a prompt string, an alist, a default
|
|
|
2345 value and an example string. The ANCHOR-PARAMETER-LIST has as an additional
|
|
|
2346 element an anchor seperator string. All these elements are used to read and
|
|
|
2347 construct the link."
|
|
70
|
2348 (let ((point nil))
|
|
|
2349 (save-window-excursion
|
|
|
2350 (let ((html-buffer (current-buffer))
|
|
|
2351 (html-help-buffer (hm--html-generate-add-link-help-buffer
|
|
|
2352 scheme-parameter-list
|
|
|
2353 host-name:port-parameter-list
|
|
|
2354 servername:port-parameter-list
|
|
|
2355 path+file-parameter-list
|
|
|
2356 anchor-parameter-list))
|
|
|
2357 (scheme (hm--html-completing-read scheme-parameter-list))
|
|
|
2358 (hostname:port (hm--html-completing-read
|
|
|
2359 host-name:port-parameter-list))
|
|
|
2360 (servername:port (hm--html-completing-read
|
|
|
2361 servername:port-parameter-list))
|
|
|
2362 (path+file (hm--html-read-filename path+file-parameter-list))
|
|
|
2363 (anchor (hm--html-completing-read anchor-parameter-list))
|
|
|
2364 ; (hrefname (setq html-link-counter (1+ html-link-counter)))
|
|
|
2365 (anchor-seperator
|
|
|
2366 (hm--html-get-anchor-seperator-from-parameter-list
|
|
|
2367 anchor-parameter-list)))
|
|
|
2368 (if (not (string= scheme ""))
|
|
|
2369 (if (string= hostname:port "")
|
|
|
2370 (setq scheme (concat scheme ":"))
|
|
|
2371 (setq scheme (concat scheme "://"))))
|
|
|
2372 (if (and (not (string= hostname:port ""))
|
|
|
2373 (not (string= servername:port ""))
|
|
|
2374 (not (string= (substring servername:port 0 1) "/")))
|
|
|
2375 (setq servername:port (concat "/" servername:port)))
|
|
|
2376 (if (and (not (string= path+file ""))
|
|
|
2377 (not (string= "/" (substring path+file 0 1))))
|
|
|
2378 (setq path+file (concat "/" path+file)))
|
|
|
2379 (if (not (string= anchor ""))
|
|
|
2380 (setq anchor (concat anchor-seperator anchor)))
|
|
|
2381 (kill-buffer html-help-buffer)
|
|
|
2382 (pop-to-buffer html-buffer)
|
|
|
2383 (eval (list function-add-tags
|
|
|
2384 ''hm--html-insert-start-tag
|
|
|
2385 (concat "<A"
|
|
0
|
2386 ; "<A Name="
|
|
|
2387 ; hrefname
|
|
70
|
2388 " HREF=\""
|
|
|
2389 scheme
|
|
|
2390 hostname:port
|
|
|
2391 servername:port
|
|
|
2392 path+file
|
|
|
2393 anchor
|
|
|
2394 "\">")
|
|
|
2395 ''hm--html-insert-end-tag
|
|
|
2396 "</A>")))
|
|
|
2397 (setq point (point))))
|
|
|
2398 (goto-char (point)))
|
|
|
2399
|
|
0
|
2400
|
|
|
2401 (defun hm--html-add-info-link-1 (function-add-tags)
|
|
|
2402 "Internal function. Adds the HTML tags for a link on a GNU Info file."
|
|
|
2403 (hm--html-add-link function-add-tags
|
|
|
2404 (list ; scheme
|
|
|
2405 ""
|
|
|
2406 nil
|
|
|
2407 "http"
|
|
|
2408 t
|
|
|
2409 "http")
|
|
|
2410 (list ; hostname:port
|
|
|
2411 "Gateway and Port: "
|
|
|
2412 hm--html-info-hostname:port-alist
|
|
|
2413 hm--html-info-hostname:port-default
|
|
|
2414 nil
|
|
|
2415 "www.tnt.uni-hannover.de:8005")
|
|
|
2416 (list ; servername:port
|
|
|
2417 ""
|
|
|
2418 nil
|
|
|
2419 ""
|
|
|
2420 t
|
|
|
2421 nil)
|
|
|
2422 (list ; path/file
|
|
|
2423 "Path/File: "
|
|
|
2424 hm--html-info-path-alist
|
|
|
2425 nil
|
|
|
2426 nil
|
|
|
2427 "/appl/lemacs/Global/info/dir")
|
|
|
2428 (list ; anchor
|
|
|
2429 "Node: "
|
|
|
2430 '((""))
|
|
|
2431 nil
|
|
|
2432 nil
|
|
|
2433 "emacs"
|
|
|
2434 ",")))
|
|
|
2435
|
|
|
2436
|
|
|
2437 (defun hm--html-add-info-link ()
|
|
|
2438 "Adds the HTML tags for a link on a GNU Info file."
|
|
|
2439 (interactive)
|
|
|
2440 (hm--html-add-info-link-1 'hm--html-add-tags))
|
|
|
2441
|
|
|
2442
|
|
|
2443 (defun hm--html-add-info-link-to-region ()
|
|
|
2444 "Adds the HTML tags for a link on a GNU Info file to the region."
|
|
|
2445 (interactive)
|
|
|
2446 (hm--html-add-info-link-1 'hm--html-add-tags-to-region))
|
|
|
2447
|
|
|
2448
|
|
|
2449 (defun hm--html-add-wais-link-1 (function-add-tags)
|
|
|
2450 "Internal function. Adds the HTML tags for a link to a WAIS server."
|
|
|
2451 (hm--html-add-link function-add-tags
|
|
|
2452 (list ; scheme
|
|
|
2453 ""
|
|
|
2454 nil
|
|
|
2455 "http"
|
|
|
2456 t
|
|
|
2457 "http")
|
|
|
2458 (list ; hostname:port
|
|
|
2459 "Gateway and Port: "
|
|
|
2460 hm--html-wais-hostname:port-alist
|
|
|
2461 hm--html-wais-hostname:port-default
|
|
|
2462 nil
|
|
|
2463 "www.tnt.uni-hannover.de:8001")
|
|
|
2464 (list ; servername:port
|
|
|
2465 "Wais Servername and Port: "
|
|
|
2466 hm--html-wais-servername:port-alist
|
|
|
2467 hm--html-wais-servername:port-default
|
|
|
2468 nil
|
|
|
2469 "quake.think.com:210")
|
|
|
2470 (list ; path/file
|
|
|
2471 "Database: "
|
|
|
2472 hm--html-wais-path-alist
|
|
|
2473 nil
|
|
|
2474 nil
|
|
|
2475 "database")
|
|
|
2476 (list ; anchor
|
|
|
2477 "Searchstring: "
|
|
|
2478 '((""))
|
|
|
2479 nil
|
|
|
2480 nil
|
|
|
2481 "searchstring"
|
|
|
2482 "?")))
|
|
|
2483
|
|
|
2484
|
|
|
2485 (defun hm--html-add-wais-link ()
|
|
|
2486 "Adds the HTML tags for a link to a WAIS server."
|
|
|
2487 (interactive)
|
|
|
2488 (hm--html-add-wais-link-1 'hm--html-add-tags))
|
|
|
2489
|
|
|
2490
|
|
|
2491 (defun hm--html-add-wais-link-to-region ()
|
|
|
2492 "Adds the HTML tags for a link to a WAIS server to the region."
|
|
|
2493 (interactive)
|
|
|
2494 (hm--html-add-wais-link-1 'hm--html-add-tags-to-region))
|
|
|
2495
|
|
|
2496
|
|
|
2497 (defun hm--html-add-direct-wais-link-1 (function-add-tags)
|
|
|
2498 "Internal function. Adds the HTML tags for a direct link to a WAIS server.
|
|
|
2499 This function uses the new direct WAIS support instead of a WAIS gateway."
|
|
|
2500 (hm--html-add-link function-add-tags
|
|
|
2501 (list ; scheme
|
|
|
2502 ""
|
|
|
2503 nil
|
|
|
2504 "wais"
|
|
|
2505 t
|
|
|
2506 "wais")
|
|
|
2507 (list ; hostname:port
|
|
|
2508 "Wais Servername and Port: "
|
|
|
2509 hm--html-wais-servername:port-alist
|
|
|
2510 hm--html-wais-servername:port-default
|
|
|
2511 nil
|
|
|
2512 "quake.think.com:210")
|
|
|
2513 (list ; servername:port
|
|
|
2514 ""
|
|
|
2515 nil
|
|
|
2516 ""
|
|
|
2517 t
|
|
|
2518 nil)
|
|
|
2519 (list ; path/file
|
|
|
2520 "Database: "
|
|
|
2521 hm--html-wais-path-alist
|
|
|
2522 nil
|
|
|
2523 nil
|
|
|
2524 "database")
|
|
|
2525 (list ; anchor
|
|
|
2526 "Searchstring: "
|
|
|
2527 '((""))
|
|
|
2528 nil
|
|
|
2529 nil
|
|
|
2530 "searchstring"
|
|
|
2531 "?")))
|
|
|
2532
|
|
|
2533
|
|
|
2534 (defun hm--html-add-direct-wais-link ()
|
|
|
2535 "Adds the HTML tags for a direct link to a WAIS server.
|
|
|
2536 This function uses the new direct WAIS support instead of a WAIS gateway."
|
|
|
2537 (interactive)
|
|
|
2538 (hm--html-add-direct-wais-link-1 'hm--html-add-tags))
|
|
|
2539
|
|
|
2540
|
|
|
2541 (defun hm--html-add-direct-wais-link-to-region ()
|
|
|
2542 "Adds the HTML tags for a direct link to a WAIS server to the region.
|
|
|
2543 This function uses the new direct WAIS support instead of a WAIS gateway."
|
|
|
2544 (interactive)
|
|
|
2545 (hm--html-add-direct-wais-link-1 'hm--html-add-tags-to-region))
|
|
|
2546
|
|
|
2547
|
|
|
2548 (defun hm--html-add-html-link-1 (function-add-tags)
|
|
|
2549 "Internal function. Adds the HTML tags for a link to an HTML page."
|
|
|
2550 (hm--html-add-link function-add-tags
|
|
|
2551 (list ; scheme
|
|
|
2552 ""
|
|
|
2553 nil
|
|
|
2554 "http"
|
|
|
2555 t
|
|
|
2556 "http")
|
|
|
2557 (list ; hostname:port
|
|
|
2558 "Servername and Port: "
|
|
|
2559 hm--html-html-hostname:port-alist
|
|
|
2560 hm--html-html-hostname:port-default
|
|
|
2561 nil
|
|
|
2562 "www.tnt.uni-hannover.de:80")
|
|
|
2563 (list ; servername:port
|
|
|
2564 ""
|
|
|
2565 nil
|
|
|
2566 ""
|
|
|
2567 t
|
|
|
2568 nil)
|
|
|
2569 (list ; path/file
|
|
|
2570 "Path/File: "
|
|
|
2571 hm--html-html-path-alist
|
|
|
2572 nil
|
|
|
2573 nil
|
|
|
2574 "/data/info/www/tnt/overview.html")
|
|
|
2575 (list ; anchor
|
|
|
2576 "Anchor: "
|
|
|
2577 '((""))
|
|
|
2578 nil
|
|
|
2579 nil
|
|
|
2580 "1"
|
|
|
2581 "#")))
|
|
|
2582
|
|
|
2583
|
|
|
2584 (defun hm--html-add-html-link ()
|
|
|
2585 "Adds the HTML tags for a link to an HTML file."
|
|
|
2586 (interactive)
|
|
|
2587 (hm--html-add-html-link-1 'hm--html-add-tags))
|
|
|
2588
|
|
|
2589
|
|
|
2590 (defun hm--html-add-html-link-to-region ()
|
|
|
2591 "Adds the HTML tags for a link to an HTML file to the region."
|
|
|
2592 (interactive)
|
|
|
2593 (hm--html-add-html-link-1 'hm--html-add-tags-to-region))
|
|
|
2594
|
|
|
2595
|
|
|
2596 (defun hm--html-add-file-link-1 (function-add-tags)
|
|
|
2597 "Internal function. Adds the HTML tags for a filegateway link."
|
|
|
2598 (hm--html-add-link function-add-tags
|
|
|
2599 (list ; scheme
|
|
|
2600 ""
|
|
|
2601 nil
|
|
|
2602 "file"
|
|
|
2603 t
|
|
|
2604 "file")
|
|
|
2605 (list ; hostname:port
|
|
|
2606 ""
|
|
|
2607 nil
|
|
|
2608 ""
|
|
|
2609 t
|
|
|
2610 nil)
|
|
|
2611 (list ; servername:port
|
|
|
2612 ""
|
|
|
2613 nil
|
|
|
2614 ""
|
|
|
2615 t
|
|
|
2616 nil)
|
|
|
2617 (list ; path/file
|
|
|
2618 "Path/File: "
|
|
|
2619 hm--html-file-path-alist
|
|
|
2620 nil
|
|
|
2621 nil
|
|
|
2622 "/data/info/www/tnt/overview.html")
|
|
|
2623 (list ; anchor
|
|
|
2624 "Anchor: "
|
|
|
2625 '((""))
|
|
|
2626 nil
|
|
|
2627 nil
|
|
|
2628 "1"
|
|
|
2629 "#")))
|
|
|
2630
|
|
|
2631
|
|
|
2632 (defun hm--html-add-file-link ()
|
|
|
2633 "Adds the HTML tags for a for a filegateway link."
|
|
|
2634 (interactive)
|
|
|
2635 (hm--html-add-file-link-1 'hm--html-add-tags))
|
|
|
2636
|
|
|
2637
|
|
|
2638 (defun hm--html-add-file-link-to-region ()
|
|
|
2639 "Adds the HTML tags for a for a filegateway link to the region."
|
|
|
2640 (interactive)
|
|
|
2641 (hm--html-add-file-link-1 'hm--html-add-tags-to-region))
|
|
|
2642
|
|
|
2643
|
|
|
2644 (defun hm--html-add-ftp-link-1 (function-add-tags)
|
|
|
2645 "Internal function. Adds the HTML tags for a link to an FTP server."
|
|
|
2646 (hm--html-add-link function-add-tags
|
|
|
2647 (list ; scheme
|
|
|
2648 ""
|
|
|
2649 nil
|
|
|
2650 "ftp"
|
|
|
2651 t
|
|
|
2652 "ftp")
|
|
|
2653 (list ; hostname:port
|
|
|
2654 "FTP Servername: "
|
|
|
2655 hm--html-ftp-hostname:port-alist
|
|
|
2656 hm--html-ftp-hostname:port-default
|
|
|
2657 nil
|
|
|
2658 "ftp.rrzn.uni-hannover.de")
|
|
|
2659 (list ; servername:port
|
|
|
2660 ""
|
|
|
2661 nil
|
|
|
2662 ""
|
|
|
2663 t
|
|
|
2664 nil)
|
|
|
2665 (list ; path/file
|
|
|
2666 "Path/File: "
|
|
|
2667 hm--html-ftp-path-alist
|
|
|
2668 nil
|
|
|
2669 nil
|
|
|
2670 "/pub/gnu/gcc-2.4.5.tar.gz")
|
|
|
2671 (list ; anchor
|
|
|
2672 ""
|
|
|
2673 nil
|
|
|
2674 ""
|
|
|
2675 t
|
|
|
2676 nil
|
|
|
2677 nil)))
|
|
|
2678
|
|
|
2679
|
|
|
2680 (defun hm--html-add-ftp-link ()
|
|
|
2681 "Adds the HTML tags for a link to an FTP server."
|
|
|
2682 (interactive)
|
|
|
2683 (hm--html-add-ftp-link-1 'hm--html-add-tags))
|
|
|
2684
|
|
|
2685
|
|
|
2686 (defun hm--html-add-ftp-link-to-region ()
|
|
|
2687 "Adds the HTML tags for a link to an FTP server to the region."
|
|
|
2688 (interactive)
|
|
|
2689 (hm--html-add-ftp-link-1 'hm--html-add-tags-to-region))
|
|
|
2690
|
|
|
2691
|
|
|
2692 (defun hm--html-add-gopher-link-1 (function-add-tags)
|
|
|
2693 "Internal function. Adds the HTML tags for a link to a gopher server."
|
|
|
2694 (hm--html-add-link function-add-tags
|
|
|
2695 (list ; scheme
|
|
|
2696 ""
|
|
|
2697 nil
|
|
|
2698 "gopher"
|
|
|
2699 t
|
|
|
2700 "gopher")
|
|
|
2701 (list ; hostname:port
|
|
|
2702 "Gopher Servername: "
|
|
|
2703 hm--html-gopher-hostname:port-alist
|
|
|
2704 hm--html-gopher-hostname:port-default
|
|
|
2705 nil
|
|
|
2706 "newsserver.rrzn.uni-hannover.de:70")
|
|
|
2707 (list ; servername:port
|
|
|
2708 "Documenttype: "
|
|
|
2709 hm--html-gopher-doctype-alist
|
|
|
2710 hm--html-gopher-doctype-default
|
|
|
2711 nil
|
|
|
2712 "/1")
|
|
|
2713 nil ; path/file
|
|
|
2714 (list ; anchor
|
|
|
2715 "Entrypoint: "
|
|
|
2716 hm--html-gopher-anchor-alist
|
|
|
2717 nil
|
|
|
2718 nil
|
|
|
2719 "Subject%20Tree"
|
|
|
2720 "/")))
|
|
|
2721
|
|
|
2722
|
|
|
2723 (defun hm--html-add-gopher-link ()
|
|
|
2724 "Adds the HTML tags for a link to a gopher server."
|
|
|
2725 (interactive)
|
|
|
2726 (hm--html-add-gopher-link-1 'hm--html-add-tags))
|
|
|
2727
|
|
|
2728
|
|
|
2729 (defun hm--html-add-gopher-link-to-region ()
|
|
|
2730 "Adds the HTML tags for a link to a gopher server to the region."
|
|
|
2731 (interactive)
|
|
|
2732 (hm--html-add-gopher-link-1 'hm--html-add-tags-to-region))
|
|
|
2733
|
|
|
2734
|
|
|
2735 (defun hm--html-make-proggate-alist (proggate-allowed-file)
|
|
|
2736 "Makes a proggate-alist from the PROGGATE-ALLOWED-FILE."
|
|
|
2737 (if (and (stringp proggate-allowed-file)
|
|
|
2738 (file-exists-p proggate-allowed-file))
|
|
|
2739 (save-window-excursion
|
|
|
2740 (let ((alist nil)
|
|
98
|
2741 (buffername (find-file-noselect proggate-allowed-file))
|
|
|
2742 (case-fold-search t))
|
|
0
|
2743 (set-buffer buffername)
|
|
|
2744 (toggle-read-only)
|
|
|
2745 (goto-char (point-min))
|
|
|
2746 (while (search-forward-regexp "[^ \t\n]+" nil t)
|
|
|
2747 (setq alist (append (list (list (buffer-substring
|
|
|
2748 (match-beginning 0)
|
|
|
2749 (match-end 0))))
|
|
|
2750 alist)))
|
|
|
2751 (kill-buffer buffername)
|
|
|
2752 alist))
|
|
|
2753 (error "ERROR: Can't find the 'hm--html-progate-allowed-file !")))
|
|
|
2754
|
|
|
2755
|
|
|
2756 (defun hm--html-add-proggate-link-1 (function-add-tags)
|
|
|
2757 "Internal function. Adds the HTML tags for a link to a program.
|
|
|
2758 The program is called via the program gateway.
|
|
|
2759 Email to muenkel@tnt.uni-hannover.de for information over
|
|
|
2760 this gateway."
|
|
|
2761 (let ((progname-alist (hm--html-make-proggate-alist
|
|
|
2762 hm--html-proggate-allowed-file)))
|
|
|
2763 (hm--html-add-link function-add-tags
|
|
|
2764 (list ; scheme
|
|
|
2765 ""
|
|
|
2766 nil
|
|
|
2767 "http"
|
|
|
2768 t
|
|
|
2769 "http")
|
|
|
2770 (list ; hostname:port
|
|
|
2771 "Servername and Port: "
|
|
|
2772 hm--html-proggate-hostname:port-alist
|
|
|
2773 hm--html-proggate-hostname:port-default
|
|
|
2774 nil
|
|
|
2775 "www.tnt.uni-hannover.de:8007")
|
|
|
2776 (list ; program
|
|
|
2777 "Programname: "
|
|
|
2778 progname-alist
|
|
|
2779 nil
|
|
|
2780 nil
|
|
|
2781 "/usr/ucb/man")
|
|
|
2782 nil ; path/file
|
|
|
2783 (list ; Program Parameter
|
|
|
2784 "Programparameter: "
|
|
|
2785 '((""))
|
|
|
2786 nil
|
|
|
2787 nil
|
|
|
2788 "8+lpd"
|
|
|
2789 "+"))))
|
|
|
2790
|
|
|
2791
|
|
|
2792 (defun hm--html-add-proggate-link ()
|
|
|
2793 "Adds the HTML tags for a link to a program.
|
|
|
2794 The program is called via the program gateway.
|
|
|
2795 Email to muenkel@tnt.uni-hannover.de for information over
|
|
|
2796 this gateway."
|
|
|
2797 (interactive)
|
|
|
2798 (hm--html-add-proggate-link-1 'hm--html-add-tags))
|
|
|
2799
|
|
|
2800
|
|
|
2801 (defun hm--html-add-proggate-link-to-region ()
|
|
|
2802 "Adds the HTML tags for a link to a program to the region.
|
|
|
2803 The program is called via the program gateway.
|
|
|
2804 Email to muenkel@tnt.uni-hannover.de for information over
|
|
|
2805 this gateway."
|
|
|
2806 (interactive)
|
|
|
2807 (hm--html-add-proggate-link-1 'hm--html-add-tags-to-region))
|
|
|
2808
|
|
|
2809
|
|
|
2810 (defun hm--html-add-local-proggate-link-1 (function-add-tags)
|
|
|
2811 "Internal function. Adds the HTML tags for a link to a program.
|
|
|
2812 The program is called via the local program gateway.
|
|
|
2813 Email to muenkel@tnt.uni-hannover.de for information over
|
|
|
2814 this gateway."
|
|
|
2815 (hm--html-add-link function-add-tags
|
|
|
2816 (list ; scheme
|
|
|
2817 ""
|
|
|
2818 nil
|
|
|
2819 ""
|
|
|
2820 t
|
|
|
2821 nil)
|
|
|
2822 (list ; hostname:port
|
|
|
2823 ""
|
|
|
2824 nil
|
|
|
2825 ""
|
|
|
2826 t
|
|
|
2827 nil)
|
|
|
2828 (list ; servername:port
|
|
|
2829 ""
|
|
|
2830 nil
|
|
|
2831 ""
|
|
|
2832 t
|
|
|
2833 nil)
|
|
|
2834 (list ; path/file
|
|
|
2835 "Path/file: "
|
|
|
2836 hm--html-local-proggate-path-alist
|
|
|
2837 nil
|
|
|
2838 nil
|
|
|
2839 "/data/info/programs/lemacs.evlm")
|
|
|
2840 (list ; anchor
|
|
|
2841 ""
|
|
|
2842 nil
|
|
|
2843 ""
|
|
|
2844 t
|
|
|
2845 nil)))
|
|
|
2846
|
|
|
2847
|
|
|
2848 (defun hm--html-add-local-proggate-link ()
|
|
|
2849 "Adds the HTML tags for a link to a program.
|
|
|
2850 The program is called via the local program gateway.
|
|
|
2851 Email to muenkel@tnt.uni-hannover.de for information over
|
|
|
2852 this gateway."
|
|
|
2853 (interactive)
|
|
|
2854 (hm--html-add-local-proggate-link-1 'hm--html-add-tags))
|
|
|
2855
|
|
|
2856
|
|
|
2857 (defun hm--html-add-local-proggate-link-to-region ()
|
|
|
2858 "Adds the HTML tags for a link to a program to the region.
|
|
|
2859 The program is called via the local program gateway.
|
|
|
2860 Email to muenkel@tnt.uni-hannover.de for information over
|
|
|
2861 this gateway."
|
|
|
2862 (interactive)
|
|
|
2863 (hm--html-add-local-proggate-link-1 'hm--html-add-tags-to-region))
|
|
|
2864
|
|
|
2865
|
|
|
2866 (defvar hm--html-newsgroup-alist nil
|
|
|
2867 "Alist with newsgroups for the newsgateway.")
|
|
|
2868
|
|
|
2869
|
|
|
2870 (defvar gnus-newsrc-assoc nil)
|
|
|
2871
|
|
|
2872
|
|
|
2873 (defun hm--html-make-newsgroup-alist ()
|
|
|
2874 "Makes a hm--html-make-newsgroup-alist from a .newsrc.el file.
|
|
|
2875 The function looks at the environment variable NNTPSERVER.
|
|
70
|
2876 If this variable exists, it trys to open the file with the Name
|
|
0
|
2877 ~/$NNTPSERVER.el. If this file exists, the alist of the file is
|
|
|
2878 returned as the newsgroup-alist. If the file doesn't exist, it
|
|
|
2879 tries to use the file ~/$NNTPSERVER to make the alist. The function
|
|
|
2880 returns '((\"\"))"
|
|
|
2881 (if hm--html-newsgroup-alist
|
|
|
2882 hm--html-newsgroup-alist
|
|
|
2883 (if gnus-newsrc-assoc
|
|
|
2884 (setq hm--html-newsgroup-alist gnus-newsrc-assoc)
|
|
|
2885 (if (not (getenv "NNTPSERVER"))
|
|
|
2886 '((""))
|
|
|
2887 (let ((newsrc-file (expand-file-name (concat "~/.newsrc-"
|
|
|
2888 (getenv "NNTPSERVER")))))
|
|
|
2889 (if (file-exists-p (concat newsrc-file ".el"))
|
|
|
2890 (progn
|
|
|
2891 (load-file (concat newsrc-file ".el"))
|
|
|
2892 (setq hm--html-newsgroup-alist gnus-newsrc-assoc))
|
|
|
2893 (if (not (file-exists-p newsrc-file))
|
|
|
2894 '((""))
|
|
|
2895 (save-window-excursion
|
|
|
2896 (let ((alist nil)
|
|
98
|
2897 (buffername (find-file-noselect newsrc-file))
|
|
|
2898 (case-fold-search t))
|
|
0
|
2899 (set-buffer buffername)
|
|
|
2900 (toggle-read-only)
|
|
|
2901 (goto-char (point-min))
|
|
|
2902 (while (search-forward-regexp "[^:!]+" nil t)
|
|
|
2903 (setq alist (append (list (list (buffer-substring
|
|
|
2904 (match-beginning 0)
|
|
|
2905 (match-end 0))))
|
|
|
2906 alist))
|
|
|
2907 (search-forward-regexp "\n"))
|
|
|
2908 (kill-buffer buffername)
|
|
|
2909 (setq hm--html-newsgroup-alist alist))))))))))
|
|
|
2910
|
|
|
2911
|
|
|
2912
|
|
|
2913 (defun hm--html-add-news-link-1 (function-add-tags)
|
|
|
2914 "Internal function. Adds the HTML tags for a link to a news group."
|
|
|
2915 (let ((newsgroup-alist (hm--html-make-newsgroup-alist)))
|
|
|
2916 (hm--html-add-link function-add-tags
|
|
|
2917 (list ; scheme
|
|
|
2918 ""
|
|
|
2919 nil
|
|
|
2920 "news"
|
|
|
2921 t
|
|
|
2922 "news")
|
|
|
2923 (list ; hostname:port
|
|
|
2924 ""
|
|
|
2925 nil
|
|
|
2926 ""
|
|
|
2927 t
|
|
|
2928 nil)
|
|
|
2929 (list ; servername:port
|
|
|
2930 "NEWS Group: "
|
|
|
2931 newsgroup-alist
|
|
|
2932 nil
|
|
|
2933 nil
|
|
|
2934 "comp.emacs.xemacs")
|
|
|
2935 nil ; path/file
|
|
|
2936 (list ; anchor
|
|
|
2937 ""
|
|
|
2938 nil
|
|
|
2939 ""
|
|
|
2940 t
|
|
|
2941 nil
|
|
|
2942 nil))))
|
|
|
2943
|
|
|
2944
|
|
|
2945 (defun hm--html-add-news-link ()
|
|
|
2946 "Adds the HTML tags for a link to a news group."
|
|
|
2947 (interactive)
|
|
|
2948 (hm--html-add-news-link-1 'hm--html-add-tags))
|
|
|
2949
|
|
|
2950
|
|
|
2951 (defun hm--html-add-news-link-to-region ()
|
|
|
2952 "Adds the HTML tags for a link to a news group to the region."
|
|
|
2953 (interactive)
|
|
|
2954 (hm--html-add-news-link-1 'hm--html-add-tags-to-region))
|
|
|
2955
|
|
|
2956
|
|
|
2957 (defun hm--html-add-mail-box-link-1 (function-add-tags)
|
|
|
2958 "Internal function. Adds the HTML tags for a link to a mail box."
|
|
|
2959 (hm--html-add-link function-add-tags
|
|
|
2960 (list ; scheme
|
|
|
2961 ""
|
|
|
2962 nil
|
|
|
2963 "http"
|
|
|
2964 t
|
|
|
2965 "http")
|
|
|
2966 (list ; hostname:port
|
|
|
2967 "Hostname and Port: "
|
|
|
2968 hm--html-mail-hostname:port-alist
|
|
|
2969 hm--html-mail-hostname:port-default
|
|
|
2970 nil
|
|
|
2971 "www.tnt.uni-hannover.de:8003")
|
|
|
2972 (list ; servername:port
|
|
|
2973 ""
|
|
|
2974 nil
|
|
|
2975 ""
|
|
|
2976 t
|
|
|
2977 nil)
|
|
|
2978 (list ; path/file
|
|
|
2979 "Path/File: "
|
|
|
2980 hm--html-mail-path-alist
|
|
|
2981 nil
|
|
|
2982 nil
|
|
|
2983 "/data/info/mail/mailbox")
|
|
|
2984 (list ; anchor
|
|
|
2985 ""
|
|
|
2986 nil
|
|
|
2987 ""
|
|
|
2988 t
|
|
|
2989 nil
|
|
|
2990 nil)))
|
|
|
2991
|
|
|
2992
|
|
|
2993 (defun hm--html-add-mail-box-link ()
|
|
|
2994 "Adds the HTML tags for a link to a mail box."
|
|
|
2995 (interactive)
|
|
70
|
2996 (hm--html-add-mail-link-1 'hm--html-add-tags))
|
|
0
|
2997
|
|
|
2998
|
|
|
2999 (defun hm--html-add-mail-box-link-to-region ()
|
|
|
3000 "Adds the HTML tags for a link to a mail box to the region."
|
|
|
3001 (interactive)
|
|
70
|
3002 (hm--html-add-mail-link-1 'hm--html-add-tags-to-region))
|
|
0
|
3003
|
|
|
3004
|
|
|
3005 (defun hm--html-add-mailto-link-1 (function-add-tags)
|
|
|
3006 "Internal function. Adds the HTML tags for a mailto link."
|
|
|
3007 (let ((mailto-alist (if (and (boundp 'user-mail-address)
|
|
|
3008 user-mail-address)
|
|
|
3009 (cons (list user-mail-address)
|
|
|
3010 hm--html-mailto-alist)
|
|
|
3011 hm--html-mailto-alist)))
|
|
|
3012 (hm--html-add-link function-add-tags
|
|
|
3013 (list ; scheme
|
|
|
3014 ""
|
|
|
3015 nil
|
|
|
3016 "mailto"
|
|
|
3017 t
|
|
|
3018 "mailto")
|
|
|
3019 (list ; hostname:port
|
|
|
3020 ""
|
|
|
3021 nil
|
|
|
3022 ""
|
|
|
3023 t
|
|
|
3024 nil)
|
|
|
3025 (list ; servername:port
|
|
2
|
3026 "Mailaddress: "
|
|
0
|
3027 mailto-alist
|
|
|
3028 nil
|
|
|
3029 nil
|
|
|
3030 "muenkel@tnt.uni-hannover.de")
|
|
|
3031 nil ; path/file
|
|
|
3032 (list ; anchor
|
|
|
3033 ""
|
|
|
3034 nil
|
|
|
3035 ""
|
|
|
3036 t
|
|
|
3037 nil
|
|
|
3038 nil))))
|
|
|
3039
|
|
|
3040 (defun hm--html-add-mailto-link ()
|
|
|
3041 "Adds the HTML tags for a mailto link."
|
|
|
3042 (interactive)
|
|
|
3043 (hm--html-add-mailto-link-1 'hm--html-add-tags))
|
|
|
3044
|
|
|
3045
|
|
|
3046 (defun hm--html-add-mailto-link-to-region ()
|
|
|
3047 "Adds the HTML tags for a mailto link to the region."
|
|
|
3048 (interactive)
|
|
|
3049 (hm--html-add-mailto-link-1 'hm--html-add-tags-to-region))
|
|
|
3050
|
|
2
|
3051 (defun hm--html-add-relative-link (relative-file-path)
|
|
|
3052 "Adds the HTML tags for a relative link at the current point."
|
|
98
|
3053 (interactive (list (file-relative-name
|
|
|
3054 (read-file-name "Relative Filename: "
|
|
|
3055 nil
|
|
|
3056 nil
|
|
|
3057 nil
|
|
|
3058 "")
|
|
|
3059 default-directory)
|
|
|
3060 ))
|
|
2
|
3061 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
3062 (concat "<A HREF=\""
|
|
|
3063 relative-file-path
|
|
|
3064 "\">")
|
|
|
3065 'hm--html-insert-end-tag
|
|
|
3066 "</A>"))
|
|
|
3067
|
|
|
3068 (defun hm--html-add-relative-link-to-region (relative-file-path)
|
|
|
3069 "Adds the HTML tags for a relative link to the region."
|
|
98
|
3070 (interactive (list (file-relative-name
|
|
|
3071 (read-file-name "Relative Filename: "
|
|
|
3072 nil
|
|
|
3073 nil
|
|
|
3074 nil
|
|
|
3075 ""))))
|
|
0
|
3076 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
3077 (concat "<A HREF=\""
|
|
2
|
3078 relative-file-path
|
|
|
3079 "\">")
|
|
|
3080 'hm--html-insert-end-tag
|
|
|
3081 "</A>"))
|
|
|
3082
|
|
|
3083 (defun hm--html-add-normal-link (link-object)
|
|
|
3084 "Adds the HTML tags for a normal general link.
|
|
|
3085 Single argument LINK-OBJECT is value of HREF in the new anchor.
|
|
|
3086 Mark is set after anchor."
|
|
|
3087 (interactive "sNode Link to: ")
|
|
|
3088 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
3089 (concat "<A HREF=\""
|
|
|
3090 link-object
|
|
|
3091 "\">")
|
|
|
3092 'hm--html-insert-end-tag
|
|
|
3093 "</A>"))
|
|
|
3094
|
|
|
3095 (defun hm--html-add-normal-link-to-region (link-object)
|
|
|
3096 "Adds the HTML tags for a normal general link to region.
|
|
|
3097 Single argument LINK-OBJECT is value of HREF in the new anchor.
|
|
|
3098 Mark is set after anchor."
|
|
|
3099 (interactive "sNode Link to: ")
|
|
|
3100 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
3101 (concat "<A HREF=\""
|
|
70
|
3102 ; (read-string "Link to: ")
|
|
2
|
3103 link-object
|
|
0
|
3104 "\">")
|
|
|
3105 'hm--html-insert-end-tag
|
|
|
3106 "</A>"))
|
|
|
3107
|
|
|
3108
|
|
|
3109 (defun hm--html-add-normal-node-link ()
|
|
|
3110 "Adds the HTML tags for a normal node link (<LINK...>) at the point."
|
|
|
3111 (interactive)
|
|
|
3112 (hm--html-insert-start-tag (concat "<LINK HREF=\""
|
|
|
3113 (read-string "Node Link to: ")
|
|
|
3114 "\">")
|
|
|
3115 ))
|
|
|
3116
|
|
|
3117 ;;; Functions to update the date and the changelog entries
|
|
|
3118
|
|
|
3119
|
|
|
3120 (defun hm--html-maybe-new-date-and-changed-comment ()
|
|
|
3121 "Hook function which updates the date in the title line, if
|
|
|
3122 'hm--html-automatic-new-date' is t and which inserts a
|
|
|
3123 \"changed comment\" line, if 'hm--html-automatic-changed-comment' is t."
|
|
|
3124 (if hm--html-automatic-new-date
|
|
|
3125 (hm--html-new-date))
|
|
|
3126 (if hm--html-automatic-changed-comment
|
|
|
3127 (hm--html-insert-changed-comment t)))
|
|
|
3128
|
|
|
3129
|
|
|
3130 (defun hm--html-new-date ()
|
|
|
3131 "The function sets the date in the title line up."
|
|
|
3132 (interactive)
|
|
|
3133 (save-excursion
|
|
|
3134 (goto-char (point-min))
|
|
|
3135 (let ((case-fold-search t)
|
|
|
3136 (end-of-head (if (search-forward "</head>" nil t)
|
|
|
3137 (point)
|
|
|
3138 (if (search-forward "<body>" nil t)
|
|
|
3139 (point)
|
|
|
3140 (point-max)))))
|
|
|
3141 (goto-char (point-min))
|
|
|
3142 (if (re-search-forward
|
|
|
3143 (concat
|
|
|
3144 "\\((\\)"
|
|
70
|
3145 "\\([ \t]*[0-3]?[0-9]-[A-Z][a-z][a-z]-[0-9][0-9][0-9][0-9][ \t]*\\)"
|
|
0
|
3146 "\\()[ \t\n]*</title>\\)")
|
|
|
3147 end-of-head
|
|
|
3148 t)
|
|
|
3149 (progn
|
|
|
3150 (delete-region (match-beginning 2) (match-end 2))
|
|
|
3151 (goto-char (match-beginning 2))
|
|
|
3152 (insert (hm--date)))))))
|
|
|
3153
|
|
|
3154
|
|
|
3155 (defun hm--html-insert-created-comment (&optional noerror)
|
|
|
3156 "The function inserts a \"created comment\".
|
|
|
3157 The comment looks like <!-- Created by: Heiko Münkel, 10-Dec-1993 -->.
|
|
|
3158 The comment will be inserted after the title line.
|
|
|
3159 An error message is printed, if there is no title line and if
|
|
|
3160 noerror is nil."
|
|
|
3161 (interactive)
|
|
|
3162 (save-excursion
|
|
|
3163 (goto-char (point-min))
|
|
|
3164 (let ((case-fold-search t)
|
|
|
3165 (end-of-head (if (search-forward "</head>" nil t)
|
|
|
3166 (point)
|
|
|
3167 (if (search-forward "<body>" nil t)
|
|
|
3168 (point)
|
|
|
3169 (point-max)))))
|
|
|
3170 (goto-char (point-min))
|
|
|
3171 (if (not (search-forward "</title>" end-of-head t))
|
|
|
3172 (if (not noerror)
|
|
|
3173 (error "ERROR: Please insert a title in the document !"))
|
|
70
|
3174 (let ((end-of-title-position (point)))
|
|
|
3175 (if (search-forward "<!-- Created by: " end-of-head t)
|
|
|
3176 (if (yes-or-no-p
|
|
|
3177 "Replace the old comment \"<!-- Created by: \" ")
|
|
|
3178 (progn
|
|
|
3179 (goto-char (match-beginning 0))
|
|
|
3180 (kill-line)
|
|
|
3181 (hm--html-add-comment)
|
|
|
3182 (insert "Created by: "
|
|
|
3183 (or hm--html-username (user-full-name))
|
|
|
3184 ", "
|
|
|
3185 (hm--date))))
|
|
|
3186 (newline)
|
|
|
3187 (hm--html-add-comment)
|
|
|
3188 (insert "Created by: "
|
|
|
3189 (or hm--html-username (user-full-name))
|
|
|
3190 ", "
|
|
|
3191 (hm--date)
|
|
|
3192 )))))))
|
|
0
|
3193
|
|
|
3194
|
|
|
3195 (defun hm--html-insert-changed-comment-1 (newline username)
|
|
|
3196 "Internal function of 'hm--html-insert-changed-comment'.
|
|
|
3197 Inserts a newline if NEWLINE is t, before the comment is inserted.
|
|
|
3198 USERNAME is the name to be inserted in the comment."
|
|
|
3199 (if newline
|
|
|
3200 (progn
|
|
70
|
3201 ; (end-of-line)
|
|
0
|
3202 (newline)))
|
|
|
3203 (hm--html-add-comment)
|
|
|
3204 (insert "Changed by: " username ", " (hm--date)))
|
|
|
3205
|
|
|
3206 (defun hm--html-insert-changed-comment (&optional noerror)
|
|
|
3207 "The function inserts a \"changed comment\".
|
|
|
3208 The comment looks like <!-- Changed by: Heiko Münkel, 10-Dec-1993 -->.
|
|
|
3209 The comment will be inserted after the last \"changed comment\" line, or,
|
|
|
3210 if there isn't such a line, after the \"created comment\" line, or,
|
|
|
3211 after the title line. If there is no title and NOERROR is nil, an error
|
|
|
3212 message is generated. The line is not inserted after the end of the head
|
|
|
3213 or the beginning of the body.
|
|
|
3214 If the last \"changed line\" is from the same author, it is only replaced
|
|
|
3215 by the new one.
|
|
|
3216
|
|
|
3217 Attention: Don't change the format of the lines and don't write anything
|
|
|
3218 else in such a line !"
|
|
|
3219 (interactive)
|
|
|
3220 (save-excursion
|
|
|
3221 (goto-char (point-min))
|
|
|
3222 (let ((case-fold-search t)
|
|
|
3223 (end-of-head (if (search-forward "</head>" nil t)
|
|
|
3224 (point)
|
|
|
3225 (if (search-forward "<body>" nil t)
|
|
|
3226 (point)
|
|
|
3227 (point-max))))
|
|
|
3228 (username (or hm--html-username (user-full-name))))
|
|
|
3229 (goto-char end-of-head)
|
|
|
3230 (if (search-backward "<!-- Changed by: " nil t)
|
|
|
3231 (if (string-match username
|
|
|
3232 (buffer-substring (point)
|
|
|
3233 (progn
|
|
|
3234 (end-of-line)
|
|
|
3235 (point))))
|
|
|
3236 ;; exchange the comment line
|
|
|
3237 (progn
|
|
|
3238 (beginning-of-line)
|
|
|
3239 (delete-region (point) (progn
|
|
|
3240 (end-of-line)
|
|
|
3241 (point)))
|
|
|
3242 (hm--html-insert-changed-comment-1 nil username))
|
|
|
3243 ;; new comment line
|
|
|
3244 (end-of-line)
|
|
|
3245 (hm--html-insert-changed-comment-1 t username))
|
|
|
3246 (if (search-backward "<!-- Created by: " nil t)
|
|
|
3247 (progn
|
|
|
3248 (end-of-line)
|
|
|
3249 (hm--html-insert-changed-comment-1 t username))
|
|
|
3250 (if (search-backward "</title>" nil t)
|
|
|
3251 (progn
|
|
|
3252 (goto-char (match-end 0))
|
|
|
3253 (if (not (looking-at "\n"))
|
|
|
3254 (progn
|
|
|
3255 (newline)
|
|
|
3256 (forward-char -1)))
|
|
|
3257 (hm--html-insert-changed-comment-1 t username))
|
|
|
3258 (if (not noerror)
|
|
|
3259 (error
|
|
|
3260 "ERROR: Insert at first a title in the document !"))))))))
|
|
|
3261
|
|
|
3262
|
|
|
3263
|
|
|
3264 ;;; Functions to insert templates
|
|
|
3265
|
|
|
3266 (defvar hm--html-template-file-history nil
|
|
98
|
3267 "Historyvariable for the template files in the `hm--html-mode'.")
|
|
0
|
3268
|
|
|
3269 (defun hm--html-insert-template (filename)
|
|
98
|
3270 "Inserts a templatefile.
|
|
|
3271 It uses `tmpl-insert-template-file' to insert
|
|
|
3272 the templates. The variables `tmpl-template-dir-list',
|
|
|
3273 `tmpl-automatic-expand' and `tmpl-history-variable-name' are
|
|
|
3274 overwritten by `hm--html-template-dir',
|
|
|
3275 `hm--html-automatic-expand-templates' and `hm--html-template-file-history'."
|
|
|
3276 (interactive (list nil))
|
|
|
3277 (let ((tmpl-template-dir-list (if (listp hm--html-template-dir)
|
|
|
3278 hm--html-template-dir
|
|
|
3279 (list hm--html-template-dir)))
|
|
|
3280 (tmpl-automatic-expand hm--html-automatic-expand-templates)
|
|
|
3281 (tmpl-history-variable-name 'hm--html-template-file-history))
|
|
|
3282 (if filename
|
|
|
3283 (tmpl-insert-template-file filename)
|
|
|
3284 (call-interactively 'tmpl-insert-template-file))
|
|
|
3285 ; (if hm--html-automatic-created-comment ; better in the template files
|
|
|
3286 ; (hm--html-insert-created-comment t)
|
|
|
3287 ))
|
|
|
3288
|
|
|
3289 (defun hm--html-insert-template-from-fixed-dirs (filename)
|
|
|
3290 "Inserts a templatefile.
|
|
|
3291 It uses `tmpl-insert-template-file-from-fixed-dirs' to insert
|
|
|
3292 the templates. The variables `tmpl-template-dir-list',
|
|
|
3293 `tmpl-automatic-expand', `tmpl-filter-regexp' and
|
|
|
3294 `tmpl-history-variable-name' are overwritten by
|
|
|
3295 `hm--html-template-dir', `hm--html-automatic-expand-templates',
|
|
|
3296 `hm--html-template-filter-regexp' and `hm--html-template-file-history'."
|
|
|
3297 (interactive (list nil))
|
|
|
3298 (let ((tmpl-template-dir-list (if (listp hm--html-template-dir)
|
|
|
3299 hm--html-template-dir
|
|
|
3300 (list hm--html-template-dir)))
|
|
|
3301 (tmpl-automatic-expand hm--html-automatic-expand-templates)
|
|
|
3302 (tmpl-filter-regexp hm--html-template-filter-regexp)
|
|
|
3303 (tmpl-history-variable-name 'hm--html-template-file-history))
|
|
|
3304 (if filename
|
|
|
3305 (tmpl-insert-template-file-from-fixed-dirs filename)
|
|
|
3306 (call-interactively 'tmpl-insert-template-file-from-fixed-dirs))
|
|
|
3307 ; (if hm--html-automatic-created-comment ; better in the template files
|
|
|
3308 ; (hm--html-insert-created-comment t)
|
|
|
3309 ))
|
|
|
3310
|
|
|
3311 ;(defun hm--html-insert-template (filename)
|
|
|
3312 ; "Inserts a templatefile."
|
|
|
3313 ; (interactive
|
|
|
3314 ; (list (tmpl-read-template-filename hm--html-template-dir
|
|
|
3315 ; hm--html-automatic-expand-templates
|
|
|
3316 ; hm--html-template-filter-regexp
|
|
|
3317 ; 'hm--html-template-file-history)))
|
|
|
3318 ; (interactive (list
|
|
|
3319 ; (let ((file-name-history hm--html-template-file-history))
|
|
|
3320 ; (read-file-name "Templatefile: "
|
|
|
3321 ; hm--html-template-dir
|
|
|
3322 ; nil
|
|
|
3323 ; t
|
|
|
3324 ; nil))))
|
|
|
3325 ;; 'hm--html-template-file-history)))
|
|
|
3326 ; (insert-file (expand-file-name filename))
|
|
|
3327 ; (if hm--html-automatic-expand-templates
|
|
|
3328 ; (tmpl-expand-templates-in-buffer))
|
|
|
3329 ; (if hm--html-automatic-created-comment
|
|
|
3330 ; (hm--html-insert-created-comment t)))
|
|
70
|
3331
|
|
|
3332
|
|
|
3333
|
|
|
3334 ;;; Functions for highlighting
|
|
|
3335
|
|
|
3336 ;(defun hm--html-toggle-use-highlighting ()
|
|
|
3337 ; "Toggles the variable html-use-highlighting."
|
|
|
3338 ; (interactive)
|
|
|
3339 ; (if html-use-highlighting
|
|
|
3340 ; (setq html-use-highlighting nil)
|
|
|
3341 ; (setq html-use-highlighting t)))
|
|
22
|
3342
|
|
0
|
3343
|
|
|
3344 ;;; Functions for font lock mode
|
|
|
3345
|
|
2
|
3346 (if (adapt-emacs19p)
|
|
0
|
3347 (progn
|
|
|
3348 (make-face 'font-lock-comment-face)
|
|
|
3349 (make-face 'font-lock-doc-string-face)
|
|
|
3350 (make-face 'font-lock-string-face)
|
|
|
3351 (or (face-differs-from-default-p 'font-lock-doc-string-face)
|
|
|
3352 (copy-face 'font-lock-comment-face 'font-lock-doc-string-face))
|
|
|
3353 (or (face-differs-from-default-p 'font-lock-comment-face)
|
|
|
3354 (copy-face 'italic 'font-lock-comment-face))
|
|
|
3355 (or (face-differs-from-default-p 'font-lock-string-face)
|
|
|
3356 (progn
|
|
|
3357 (copy-face 'font-lock-doc-string-face 'font-lock-string-face)
|
|
|
3358 (set-face-underline-p 'font-lock-string-face t)))
|
|
|
3359 (setq font-lock-comment-face 'font-lock-comment-face)
|
|
70
|
3360 ;; (setq font-lock-doc-string-face 'font-lock-doc-string-face)
|
|
0
|
3361 (setq font-lock-string-face 'font-lock-string-face)))
|
|
|
3362
|
|
|
3363
|
|
70
|
3364 ;(defun hm--html-set-font-lock-color ()
|
|
|
3365 ; "Sets the color for the font lock mode in HTML mode.
|
|
|
3366 ;This color is used to highlight HTML expressions."
|
|
|
3367 ; (interactive)
|
|
|
3368 ; (setq hm--html-font-lock-color
|
|
|
3369 ; (completing-read "Color: "
|
|
|
3370 ; '(("grey80")
|
|
|
3371 ; ("black")
|
|
|
3372 ; ("red")
|
|
|
3373 ; ("yellow")
|
|
|
3374 ; ("blue"))
|
|
|
3375 ; nil
|
|
|
3376 ; nil
|
|
|
3377 ; "black"))
|
|
|
3378 ; (set-face-foreground 'font-lock-comment-face hm--html-font-lock-color)
|
|
|
3379 ; (set-face-foreground 'font-lock-string-face hm--html-font-lock-color))
|
|
|
3380
|
|
|
3381
|
|
|
3382 ;;; Functions which determine if an active region exists
|
|
|
3383
|
|
|
3384 ;(defvar hm--region-active nil
|
|
|
3385 ; "t : Region is active.
|
|
|
3386 ;nil: Region is inactive.")
|
|
|
3387 ;
|
|
|
3388 ;
|
|
|
3389 ;(defun hm--set-hm--region-active ()
|
|
|
3390 ; (setq hm--region-active t))
|
|
|
3391 ;
|
|
|
3392 ;
|
|
|
3393 ;(defun hm--unset-hm--region-active ()
|
|
|
3394 ; (setq hm--region-active nil))
|
|
|
3395
|
|
|
3396
|
|
|
3397
|
|
0
|
3398 ;;; Functions to insert forms
|
|
|
3399
|
|
|
3400 (defun hm--html-form-read-method ()
|
|
|
3401 "Reads the method for a form."
|
|
|
3402 (completing-read "Method of the form: "
|
|
|
3403 '(("POST") ("GET"))
|
|
|
3404 nil
|
|
|
3405 t
|
|
|
3406 "POST"))
|
|
|
3407
|
|
|
3408
|
|
|
3409 (defun hm--html-form-read-action (method)
|
|
|
3410 "Reads the URL for the action attribute of a form.
|
|
|
3411 It returns nil if no action attribute is wanted.
|
|
|
3412 METHOD is the method of the form."
|
|
|
3413 (if (y-or-n-p "Current document URL as action attribute ? ")
|
|
|
3414 nil
|
|
|
3415 (hm--html-read-url "Query server URL: "
|
|
|
3416 hm--html-url-alist
|
|
|
3417 (function
|
|
|
3418 (lambda (table-element-list)
|
|
|
3419 (hm--html-read-url-predicate table-element-list
|
|
|
3420 (car
|
|
|
3421 (read-from-string
|
|
|
3422 method)))))
|
|
|
3423 nil
|
|
|
3424 nil)))
|
|
|
3425
|
|
|
3426
|
|
|
3427 (defun hm--html-add-form (&optional method)
|
|
|
3428 "Adds the HTML tags for a form.
|
|
|
3429 The function asks only for a method, if METHOD is nil, otherwise
|
|
|
3430 the METHOD must have one of the values \"GET\" or \"POST\"."
|
|
|
3431 (interactive)
|
|
|
3432 (let* ((method (or method (hm--html-form-read-method)))
|
|
|
3433 (action (hm--html-form-read-action method)))
|
|
|
3434 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
3435 (concat "<FORM METHOD=\""
|
|
|
3436 method
|
|
|
3437 "\""
|
|
|
3438 (if action
|
|
|
3439 (concat " ACTION=\""
|
|
|
3440 action
|
|
|
3441 "\"")
|
|
|
3442 "")
|
|
|
3443 ">")
|
|
|
3444 'hm--html-insert-end-tag-with-newline
|
|
|
3445 "</FORM>")))
|
|
|
3446
|
|
|
3447
|
|
|
3448 (defun hm--html-add-form-to-region (&optional method)
|
|
|
3449 "Adds the HTML tags for a form to a region.
|
|
|
3450 The function asks only for a method, if METHOD is nil, otherwise
|
|
|
3451 the METHOD must have one of the values \"GET\" or \"POST\"."
|
|
|
3452 (interactive)
|
|
|
3453 (let* ((method (or method (hm--html-form-read-method)))
|
|
|
3454 (action (hm--html-form-read-action method)))
|
|
|
3455 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
3456 (concat "<FORM METHOD=\""
|
|
|
3457 method
|
|
|
3458 "\""
|
|
|
3459 (if action
|
|
|
3460 (concat " ACTION=\""
|
|
|
3461 action
|
|
|
3462 "\"")
|
|
|
3463 "")
|
|
|
3464 ">")
|
|
|
3465 'hm--html-insert-end-tag-with-newline
|
|
|
3466 "</FORM>")))
|
|
|
3467
|
|
|
3468
|
|
|
3469 (defun hm--html-form-read-name (&optional last-name)
|
|
|
3470 "Reads the name for an input tag."
|
|
|
3471 (read-string "Symbolic name: " last-name))
|
|
|
3472
|
|
|
3473
|
|
|
3474 (defun hm--html-form-read-value (prompt &optional initial-contents)
|
|
|
3475 "Reads the value for an input tag."
|
|
|
3476 (read-string prompt initial-contents))
|
|
|
3477
|
|
|
3478
|
|
|
3479 (defun hm--html-form-read-checked ()
|
|
|
3480 "Reads whether a button is checked by default or not."
|
|
|
3481 (y-or-n-p "Should the button be checked by default ? "))
|
|
|
3482
|
|
|
3483
|
|
|
3484 (defun hm--html-form-read-size ()
|
|
|
3485 "Reads the size of text entry fields of input tags."
|
|
|
3486 (if (y-or-n-p "Defaultsize of the Inputfield ? ")
|
|
|
3487 nil
|
|
|
3488 (format "%d,%d"
|
|
|
3489 (read-number "Width of the input field: " t)
|
|
|
3490 (read-number "Height of the input field: " t))))
|
|
|
3491
|
|
|
3492
|
|
|
3493 (defun hm--html-form-read-maxlength ()
|
|
|
3494 "Reads the maxlength of text entry fields of input tags."
|
|
|
3495 (let ((maxlength (read-number "Maximum number of chars (0 = unlimited): "
|
|
|
3496 t)))
|
|
|
3497 (if (<= maxlength 0)
|
|
|
3498 nil
|
|
|
3499 (int-to-string maxlength))))
|
|
|
3500
|
|
|
3501
|
|
|
3502 (defun hm--html-form-read-src (prompt &optional initial-contents)
|
|
|
3503 "Reads the src for an input tag."
|
|
|
3504 (read-string prompt initial-contents))
|
|
|
3505
|
|
|
3506
|
|
|
3507 (defun hm--html-form-add-input (type
|
|
|
3508 name
|
|
|
3509 value
|
|
|
3510 checked
|
|
|
3511 size
|
|
|
3512 maxlength
|
|
|
3513 &optional src)
|
|
|
3514 "Adds the HTML tags for an input tag to the buffer."
|
|
|
3515 (hm--html-insert-start-tag (concat "<INPUT TYPE=\""
|
|
|
3516 type
|
|
|
3517 "\""
|
|
|
3518 (if (and name (not (string= name "")))
|
|
|
3519 (concat " NAME=\"" name "\""))
|
|
|
3520 (if (and value (not (string= value "")))
|
|
|
3521 (concat " VALUE=\"" value "\""))
|
|
|
3522 (if checked " CHECKED")
|
|
|
3523 (if (and size (not (string= size "")))
|
|
|
3524 (concat " SIZE=" size))
|
|
|
3525 (if (and maxlength
|
|
|
3526 (not (string= maxlength "")))
|
|
|
3527 (concat " MAXLENGTH="
|
|
|
3528 maxlength
|
|
|
3529 ))
|
|
|
3530 (if (and src
|
|
|
3531 (not (string= src "")))
|
|
|
3532 (concat " SRC=\""
|
|
|
3533 src
|
|
|
3534 "\""))
|
|
|
3535 ">")))
|
|
|
3536
|
|
|
3537
|
|
|
3538 (defun hm--html-form-add-input-text (name value size maxlength)
|
|
|
3539 "Adds the HTML tags for a text input field."
|
|
|
3540 (interactive (list (hm--html-form-read-name)
|
|
|
3541 (hm--html-form-read-value "Defaultvalue: ")
|
|
|
3542 (hm--html-form-read-size)
|
|
|
3543 (hm--html-form-read-maxlength)))
|
|
|
3544 (hm--html-form-add-input "text" name value nil size maxlength))
|
|
|
3545
|
|
|
3546
|
|
|
3547 (defun hm--html-form-add-input-password (name value size maxlength)
|
|
|
3548 "Adds the HTML tags for a password input field."
|
|
|
3549 (interactive (list (hm--html-form-read-name)
|
|
|
3550 (hm--html-form-read-value "Defaultvalue: ")
|
|
|
3551 (hm--html-form-read-size)
|
|
|
3552 (hm--html-form-read-maxlength)))
|
|
|
3553 (hm--html-form-add-input "password" name value nil size maxlength))
|
|
|
3554
|
|
|
3555
|
|
|
3556 (defun hm--html-form-add-input-integer (name value size maxlength)
|
|
|
3557 "Adds the HTML tags for a integer input field."
|
|
|
3558 (interactive (list (hm--html-form-read-name)
|
|
|
3559 (hm--html-form-read-value "Defaultvalue: ")
|
|
|
3560 (hm--html-form-read-size)
|
|
|
3561 (hm--html-form-read-maxlength)))
|
|
|
3562 (hm--html-form-add-input "int" name value nil size maxlength))
|
|
|
3563
|
|
|
3564
|
|
|
3565 (defun hm--html-form-add-input-float (name value size maxlength)
|
|
|
3566 "Adds the HTML tags for a float input field."
|
|
|
3567 (interactive (list (hm--html-form-read-name)
|
|
|
3568 (hm--html-form-read-value "Defaultvalue: ")
|
|
|
3569 (hm--html-form-read-size)
|
|
|
3570 (hm--html-form-read-maxlength)))
|
|
|
3571 (hm--html-form-add-input "float" name value nil size maxlength))
|
|
|
3572
|
|
|
3573
|
|
|
3574 (defun hm--html-form-add-input-date (name value size maxlength)
|
|
|
3575 "Adds the HTML tags for a date input field."
|
|
|
3576 (interactive (list (hm--html-form-read-name)
|
|
|
3577 (hm--html-form-read-value "Defaultvalue: ")
|
|
|
3578 (hm--html-form-read-size)
|
|
|
3579 (hm--html-form-read-maxlength)))
|
|
|
3580 (hm--html-form-add-input "date" name value nil size maxlength))
|
|
|
3581
|
|
|
3582
|
|
|
3583 (defun hm--html-form-add-input-url (name value size maxlength)
|
|
|
3584 "Adds the HTML tags for a url input field."
|
|
|
3585 (interactive (list (hm--html-form-read-name)
|
|
|
3586 (hm--html-form-read-value "Defaultvalue: ")
|
|
|
3587 (hm--html-form-read-size)
|
|
|
3588 (hm--html-form-read-maxlength)))
|
|
|
3589 (hm--html-form-add-input "url" name value nil size maxlength))
|
|
|
3590
|
|
|
3591
|
|
|
3592 (defun hm--html-form-add-input-scribble (name value size maxlength)
|
|
|
3593 "Adds the HTML tags for a scribble input field."
|
|
|
3594 (interactive (list (hm--html-form-read-name)
|
|
|
3595 (hm--html-form-read-value "Defaultvalue: ")
|
|
|
3596 (hm--html-form-read-size)
|
|
|
3597 (hm--html-form-read-maxlength)))
|
|
|
3598 (hm--html-form-add-input "scribble" name value nil size maxlength))
|
|
|
3599
|
|
|
3600
|
|
|
3601 (defun hm--html-form-add-input-checkbox (name value checked)
|
|
|
3602 "Adds the HTML tags for a checkbox button."
|
|
|
3603 (interactive (list (hm--html-form-read-name)
|
|
|
3604 (hm--html-form-read-value "Checkbox value: ")
|
|
|
3605 (hm--html-form-read-checked)))
|
|
|
3606 (hm--html-form-add-input "checkbox" name value checked nil nil))
|
|
|
3607
|
|
|
3608
|
|
|
3609 (defvar hm--html-last-radio-button-name nil
|
|
|
3610 "Name of the last radio button.")
|
|
|
3611
|
|
|
3612
|
|
|
3613 (defun hm--html-form-add-input-radio (name value checked)
|
|
|
3614 "Adds the HTML tags for a radio button."
|
|
|
3615 (interactive (list (hm--html-form-read-name hm--html-last-radio-button-name)
|
|
|
3616 (hm--html-form-read-value "Radiobutton value: ")
|
|
|
3617 (hm--html-form-read-checked)))
|
|
|
3618 (setq hm--html-last-radio-button-name name)
|
|
|
3619 (hm--html-form-add-input "radio" name value checked nil nil))
|
|
|
3620
|
|
|
3621
|
|
|
3622 (defun hm--html-form-add-input-submit (value)
|
|
|
3623 "Adds the HTML tags for a submit input field."
|
|
|
3624 (interactive (list (hm--html-form-read-value
|
|
|
3625 "Label of the submit button: "
|
|
|
3626 "Submit")))
|
|
|
3627 (hm--html-form-add-input "submit" nil value nil nil nil))
|
|
|
3628
|
|
|
3629
|
|
|
3630 (defun hm--html-form-add-input-image (name src)
|
|
|
3631 "Adds the HTML tags for an image input field."
|
|
|
3632 (interactive (list (hm--html-form-read-name)
|
|
|
3633 (hm--html-read-url "Image URL: "
|
|
|
3634 hm--html-url-alist
|
|
|
3635 (function
|
|
|
3636 (lambda (table-element-list)
|
|
|
3637 (hm--html-read-url-predicate
|
|
|
3638 table-element-list
|
|
|
3639 'IMAGE)))
|
|
|
3640 nil
|
|
|
3641 nil)))
|
|
|
3642 (hm--html-form-add-input "IMAGE"
|
|
|
3643 name
|
|
|
3644 nil
|
|
|
3645 nil
|
|
|
3646 nil
|
|
|
3647 nil
|
|
|
3648 src))
|
|
|
3649
|
|
|
3650
|
|
|
3651 (defun hm--html-form-add-input-audio (name src)
|
|
|
3652 "Adds the HTML tags for an audio input field."
|
|
|
3653 (interactive (list (hm--html-form-read-name)
|
|
|
3654 (hm--html-read-url "Audio URL: "
|
|
|
3655 hm--html-url-alist
|
|
|
3656 (function
|
|
|
3657 (lambda (table-element-list)
|
|
|
3658 (hm--html-read-url-predicate
|
|
|
3659 table-element-list
|
|
|
3660 'AUDIO)))
|
|
|
3661 nil
|
|
|
3662 nil)))
|
|
|
3663 (hm--html-form-add-input "AUDIO"
|
|
|
3664 name
|
|
|
3665 nil
|
|
|
3666 nil
|
|
|
3667 nil
|
|
|
3668 nil
|
|
|
3669 src))
|
|
|
3670
|
|
|
3671
|
|
|
3672 (defun hm--html-form-add-input-reset (value)
|
|
|
3673 "Adds the HTML tags for a reset input field."
|
|
|
3674 (interactive (list (hm--html-form-read-value
|
|
|
3675 "Label of the reset button: "
|
|
|
3676 "Reset")))
|
|
|
3677 (hm--html-form-add-input "reset" nil value nil nil nil))
|
|
|
3678
|
|
|
3679
|
|
|
3680 (defun hm--html-form-add-input-isindex (size)
|
|
|
3681 "Adds the HTML tags for an isindex input field.
|
|
|
3682 Size is the value of the input field wide."
|
|
|
3683 (interactive "nWidth of the input field (i.e: 20): ")
|
|
|
3684 (hm--html-insert-start-tag (concat "<INPUT NAME=\"isindex\""
|
|
|
3685 (if (= size 20)
|
|
|
3686 ">"
|
|
|
3687 (format
|
|
|
3688 " SIZE=%d>"
|
|
|
3689 size)))))
|
|
|
3690
|
|
|
3691
|
|
|
3692 (defun hm--html-form-add-select-option-menu (name)
|
|
|
3693 "Adds the HTML tags for a select option menu to the buffer."
|
|
|
3694 (interactive (list (hm--html-form-read-name)))
|
|
|
3695 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
3696 (concat "<SELECT NAME=\"" name "\">")
|
|
|
3697 'hm--html-insert-end-tag-with-newline
|
|
|
3698 "</SELECT>"
|
|
|
3699 'hm--html-insert-start-tag
|
|
|
3700 "<OPTION> "))
|
|
|
3701
|
|
|
3702
|
|
|
3703 (defun hm--html-form-add-select-scrolled-list (name listsize multiple)
|
|
|
3704 "Adds the HTML tags for a select scrolled list to the buffer."
|
|
|
3705 (interactive (list (hm--html-form-read-name)
|
|
|
3706 (read-number "No of visible items (>1): " t)
|
|
|
3707 (y-or-n-p "Multiple selections allowed ? ")))
|
|
|
3708 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
3709 (concat "<SELECT NAME=\""
|
|
|
3710 name
|
|
|
3711 "\" SIZE="
|
|
|
3712 (int-to-string listsize)
|
|
|
3713 (if multiple
|
|
|
3714 " MULTIPLE")
|
|
|
3715 ">")
|
|
|
3716 'hm--html-insert-end-tag-with-newline
|
|
|
3717 "</SELECT>"
|
|
|
3718 'hm--html-insert-start-tag
|
|
|
3719 "<OPTION> "))
|
|
|
3720
|
|
|
3721
|
|
|
3722 (defun hm--html-form-add-select-option (selected-by-default)
|
|
|
3723 "Adds the tags for an option in a select form menu."
|
|
|
3724 (interactive (list (y-or-n-p "Select this option by default ? ")))
|
|
|
3725 (hm--html-insert-end-tag-with-newline (concat "<OPTION"
|
|
|
3726 (if selected-by-default
|
|
|
3727 " SELECTED")
|
|
|
3728 "> ")))
|
|
|
3729
|
|
|
3730
|
|
|
3731 (defun hm--html-form-add-textarea (name rows columns)
|
|
|
3732 "Adds the tags for a textarea tag."
|
|
|
3733 (interactive (list (hm--html-form-read-name)
|
|
|
3734 (read-number "Number of Rows of the Textarea: " t)
|
|
|
3735 (read-number "Number of Columns of the Textarea: " t)))
|
|
|
3736 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
3737 (concat "<TEXTAREA NAME=\""
|
|
|
3738 name
|
|
|
3739 "\" ROWS="
|
|
|
3740 (int-to-string rows)
|
|
|
3741 " COLS="
|
|
|
3742 (int-to-string columns)
|
|
|
3743 ">")
|
|
|
3744 'hm--html-insert-end-tag
|
|
|
3745 "</TEXTAREA>"))
|
|
|
3746
|
|
|
3747
|
|
|
3748 ;;; Functions to insert tables
|
|
|
3749
|
|
|
3750 (defun hm--html-add-table (border compact)
|
|
|
3751 "Add the HTML tags for a table frame.
|
|
|
3752 If BORDER is t, then the table should be drawn with a border.
|
|
|
3753 If COMPACT is t, then the table should be drawn in a smaller size."
|
|
|
3754 (interactive (list (y-or-n-p "Use a table with a border? ")
|
|
|
3755 (y-or-n-p "Use a small table? ")))
|
|
|
3756 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
|
3757 (concat "<TABLE"
|
|
|
3758 (if border " border" "")
|
|
|
3759 (if compact " compact" "")
|
|
|
3760 ">")
|
|
|
3761 'hm--html-insert-start-tag-with-newline
|
|
|
3762 "</TABLE>")
|
|
|
3763 (backward-char))
|
|
|
3764
|
|
|
3765
|
|
|
3766 (defun hm--html-add-table-to-region (border compact)
|
|
|
3767 "Add the HTML tags for a table frame.
|
|
|
3768 If BORDER is t, then the table should be drawn with a border.
|
|
|
3769 If COMPACT is t, then the table should be drawn in a smaller size."
|
|
|
3770 (interactive (list (y-or-n-p "Use a table with a border? ")
|
|
|
3771 (y-or-n-p "Use a small table? ")))
|
|
|
3772 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
|
3773 (concat "<TABLE"
|
|
|
3774 (if border " border" "")
|
|
|
3775 (if compact " compact" "")
|
|
|
3776 ">")
|
|
|
3777 'hm--html-insert-start-tag-with-newline
|
|
|
3778 "</TABLE>"))
|
|
|
3779
|
|
|
3780
|
|
|
3781 (defun hm--html-add-table-title (top)
|
|
|
3782 "Adds the HTML tag for a table title at the current point.
|
|
|
3783 If TOP is t, then the title will positioned at the top instead of the
|
|
|
3784 bottom of the table."
|
|
|
3785 (interactive (list (y-or-n-p "Put the title at the table top? ")))
|
|
|
3786 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
3787 (concat "\n<CAPTION"
|
|
|
3788 (if top " align=top" " align=bottom")
|
|
|
3789 "> ")
|
|
|
3790 'hm--html-insert-end-tag
|
|
|
3791 " </CAPTION>"))
|
|
|
3792
|
|
|
3793
|
|
|
3794 (defun hm--html-add-table-title-to-region (top)
|
|
|
3795 "Adds the HTML tag for a table title to the region.
|
|
|
3796 If TOP is t, then the title will positioned at the top instead of the
|
|
|
3797 bottom of the table."
|
|
|
3798 (interactive (list (y-or-n-p "Put the title at the table top? ")))
|
|
|
3799 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
3800 (concat "<CAPTION"
|
|
|
3801 (if top " align=top" " align=bottom")
|
|
|
3802 "> ")
|
|
|
3803 'hm--html-insert-end-tag
|
|
|
3804 " </CAPTION>"))
|
|
|
3805
|
|
|
3806
|
|
|
3807 (defvar hm--html-table-alignment-alist '(("default")
|
|
|
3808 ("left")
|
|
|
3809 ("right")
|
|
|
3810 ("center"))
|
|
|
3811 "Alist with table alignments.")
|
|
|
3812
|
|
|
3813 (defun hm--html-table-read-cell-entries-and-alignments (cell-no
|
|
|
3814 no-of-cells
|
|
|
3815 &optional
|
|
|
3816 alignment-list)
|
|
|
3817 "Reads the alignments and the entries for NO-OF-CELLS cells.
|
|
|
3818 The return is a list with strings of the form: \"align=left> entry\".
|
|
|
3819 CELL-NO is the current cell no.
|
|
|
3820 If (car ALIGNMENT-LIST) is non-nil, then it is used as alignment."
|
|
|
3821 (if (> cell-no no-of-cells)
|
|
|
3822 nil
|
|
|
3823 (let ((alignment
|
|
|
3824 (or (car alignment-list)
|
|
|
3825 (completing-read (format "Alignment of the %d. cell: "
|
|
|
3826 cell-no)
|
|
|
3827 hm--html-table-alignment-alist
|
|
|
3828 nil
|
|
|
3829 t
|
|
|
3830 "default")))
|
|
|
3831 (entry (read-string (format "Entry of the %d. cell: " cell-no))))
|
|
|
3832 (if (string= "default" alignment)
|
|
|
3833 (setq alignment "")
|
|
|
3834 (setq alignment (concat " align=" alignment)))
|
|
|
3835 (cons (concat alignment "> " entry)
|
|
|
3836 (hm--html-table-read-cell-entries-and-alignments (1+ cell-no)
|
|
|
3837 no-of-cells
|
|
|
3838 (cdr
|
|
|
3839 alignment-list))
|
|
|
3840 ))))
|
|
|
3841
|
|
|
3842 (defun hm--html-add-table-header (no-of-cells)
|
|
|
3843 "Adds the HTML tags for a complete simple table header line.
|
|
|
3844 It asks for the number of cells and the allignment of the cells.
|
|
|
3845 The number of cells can also be given as prefix argument."
|
|
|
3846 (interactive "NNo of cells in a row: ")
|
|
|
3847 (if (< no-of-cells 1)
|
|
|
3848 (error "ERROR: There must be at least one cell in a row!"))
|
|
|
3849 (hm--html-add-tags
|
|
|
3850 'hm--html-insert-end-tag-with-newline
|
|
98
|
3851 (concat "<TR>"
|
|
|
3852 (mapconcat '(lambda (entry)
|
|
|
3853 (concat "<TH" entry))
|
|
|
3854 (hm--html-table-read-cell-entries-and-alignments
|
|
|
3855 1
|
|
|
3856 no-of-cells)
|
|
|
3857 " </TH>")
|
|
|
3858 " </TH></TR>")))
|
|
0
|
3859
|
|
|
3860
|
|
|
3861 (defun hm--html-add-first-table-row (no-of-cells)
|
|
|
3862 "Adds the HTML tags for a table row.
|
|
|
3863 It asks for the number of cells and the allignment of the cells.
|
|
|
3864 The number of cells can also be given as prefix argument."
|
|
|
3865 (interactive "NNo of cells in a row: ")
|
|
|
3866 (if (< no-of-cells 1)
|
|
|
3867 (error "ERROR: There must be at least one cell in a row!"))
|
|
|
3868 (hm--html-add-tags
|
|
|
3869 'hm--html-insert-end-tag-with-newline
|
|
98
|
3870 (concat "<TR><TD"
|
|
|
3871 (car (hm--html-table-read-cell-entries-and-alignments 1 1))
|
|
|
3872 " </TD>"
|
|
0
|
3873 (if (<= no-of-cells 1)
|
|
98
|
3874 "</TR>"
|
|
0
|
3875 (concat
|
|
|
3876 (mapconcat '(lambda (entry)
|
|
|
3877 (concat "<TD" entry))
|
|
|
3878 (hm--html-table-read-cell-entries-and-alignments
|
|
|
3879 2 no-of-cells)
|
|
98
|
3880 " </TD>")
|
|
|
3881 " </TD></TR>")))))
|
|
0
|
3882
|
|
|
3883
|
|
|
3884 (defun hm--html-table-get-previous-alignments ()
|
|
|
3885 "Returns a list with the alignments of the previous table row.
|
|
|
3886 The row must be a data row and not a header row!
|
|
|
3887 An example for the return list: '(\"left\" \"default\" \"center\" \"right\")"
|
|
|
3888 (save-excursion
|
|
|
3889 (let* ((point-of-view (point))
|
|
98
|
3890 (case-fold-search t)
|
|
|
3891 (end-of-last-row (search-backward "</tr>" (point-min) t))
|
|
|
3892 (begin-of-last-row (progn (search-backward "<tr" (point-min) t)
|
|
|
3893 (re-search-forward "<t[dh]"
|
|
|
3894 point-of-view t)
|
|
0
|
3895 (match-beginning 0)))
|
|
|
3896 (alignment-list nil))
|
|
98
|
3897 (goto-char begin-of-last-row)
|
|
|
3898 (if (not (re-search-forward "<t[dh]" end-of-last-row t))
|
|
0
|
3899 (error "Error: No previous data row found!")
|
|
|
3900 (goto-char end-of-last-row)
|
|
|
3901 (while (> (point) begin-of-last-row)
|
|
|
3902 (let ((cell-start
|
|
|
3903 (search-backward-regexp "\\(<td[^>]*>\\)\\|\\(<th[^>]*>\\)"
|
|
|
3904 begin-of-last-row
|
|
|
3905 t)))
|
|
|
3906 (if (not cell-start)
|
|
|
3907 (goto-char begin-of-last-row)
|
|
|
3908 (setq alignment-list
|
|
|
3909 (cons
|
|
|
3910 (if (search-forward-regexp "\\(align=\\)\\([^ \t\n>]*\\)"
|
|
|
3911 (match-end 0)
|
|
|
3912 t)
|
|
|
3913 (buffer-substring (match-beginning 2)
|
|
|
3914 (match-end 2))
|
|
|
3915 "default")
|
|
|
3916 alignment-list))
|
|
|
3917 (goto-char cell-start))))
|
|
|
3918 alignment-list))))
|
|
|
3919
|
|
|
3920
|
|
|
3921 (defun hm--html-add-additional-table-row ()
|
|
|
3922 "Adds the HTML tags for a table row.
|
|
|
3923 It tries to detect the number of cells and their alignments
|
|
|
3924 from existing rows of the table."
|
|
|
3925 (interactive)
|
|
|
3926 (let* ((old-alignment-list (hm--html-table-get-previous-alignments))
|
|
|
3927 (no-of-cells (length old-alignment-list)))
|
|
|
3928 (hm--html-add-tags
|
|
|
3929 'hm--html-insert-end-tag-with-newline
|
|
98
|
3930 (concat "<TR><TD" (car (hm--html-table-read-cell-entries-and-alignments
|
|
|
3931 1
|
|
|
3932 1
|
|
|
3933 old-alignment-list))
|
|
|
3934 " </TD>"
|
|
0
|
3935 (if (<= no-of-cells 1)
|
|
98
|
3936 "</TR>"
|
|
0
|
3937 (concat
|
|
|
3938 (mapconcat '(lambda (entry)
|
|
|
3939 (concat "<TD" entry))
|
|
|
3940 (hm--html-table-read-cell-entries-and-alignments
|
|
|
3941 2
|
|
|
3942 no-of-cells
|
|
|
3943 (cdr old-alignment-list))
|
|
98
|
3944 " </TD>")
|
|
|
3945 " </TD></TR>"))))))
|
|
0
|
3946
|
|
|
3947
|
|
|
3948 (defun hm--html-add-row-entry (alignment)
|
|
|
3949 "Adds the HTML tag for a table row entry at the current point."
|
|
|
3950 (interactive (list (completing-read "Alignment of the cell: "
|
|
|
3951 hm--html-table-alignment-alist
|
|
|
3952 nil
|
|
|
3953 t
|
|
|
3954 "default")))
|
|
|
3955 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
3956 (concat "<TD"
|
|
|
3957 (if (string= "default" alignment)
|
|
|
3958 "> "
|
|
|
3959 (concat " align=" alignment "> ")))))
|
|
|
3960
|
|
|
3961
|
|
|
3962 (defun hm--html-add-header-entry (alignment)
|
|
|
3963 "Adds the HTML tag for a table header entry at the current point."
|
|
|
3964 (interactive (list (completing-read "Alignment of the cell: "
|
|
|
3965 hm--html-table-alignment-alist
|
|
|
3966 nil
|
|
|
3967 t
|
|
|
3968 "default")))
|
|
|
3969 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
3970 (concat "<TH"
|
|
|
3971 (if (string= "default" alignment)
|
|
|
3972 "> "
|
|
|
3973 (concat " align=" alignment "> ")))))
|
|
|
3974
|
|
|
3975
|
|
|
3976 (defun hm--html-add-row-frame (alignment)
|
|
|
3977 "Adds the HTML tags for a table row start and end at the current point."
|
|
|
3978 (interactive (list (completing-read "Alignment of the start cell: "
|
|
|
3979 hm--html-table-alignment-alist
|
|
|
3980 nil
|
|
|
3981 t
|
|
|
3982 "default")))
|
|
|
3983 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
|
3984 (concat "<TD"
|
|
|
3985 (if (string= "default" alignment)
|
|
|
3986 "> "
|
|
|
3987 (concat " align=" alignment "> ")))
|
|
|
3988 'hm--html-insert-end-tag
|
|
|
3989 "<TR>"))
|
|
|
3990
|
|
|
3991
|
|
|
3992 (defun hm--html-add-row-frame-to-region (alignment)
|
|
|
3993 "Adds the HTML tags for a table row start and end to the current region."
|
|
|
3994 (interactive (list (completing-read "Alignment of the start cell: "
|
|
|
3995 hm--html-table-alignment-alist
|
|
|
3996 nil
|
|
|
3997 t
|
|
|
3998 "default")))
|
|
|
3999 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
|
4000 (concat "<TD"
|
|
|
4001 (if (string= "default" alignment)
|
|
|
4002 "> "
|
|
|
4003 (concat " align=" alignment "> ")))
|
|
|
4004 'hm--html-insert-end-tag
|
|
|
4005 " <TR>"))
|
|
|
4006
|
|
|
4007
|
|
|
4008 (defun hm--html-table-add-colspan-attribute (columns)
|
|
|
4009 "Adds a colspawn attribute to a table cell.
|
|
|
4010 A prefix arg is used as no of COLUMNS."
|
|
|
4011 (interactive "NNo of columns, spaned by this cell: ")
|
|
98
|
4012 (let ((case-fold-search t))
|
|
|
4013 (save-excursion
|
|
|
4014 (if (and (search-backward "<" nil t)
|
|
|
4015 (search-forward-regexp "<[ \t\n]*\\(th\\)\\|\\(td\\)" nil t))
|
|
|
4016 (if (search-forward-regexp "\\([ \t\n]+colspan=\\)\\([^ \t\n>]*\\)"
|
|
|
4017 nil
|
|
|
4018 t)
|
|
|
4019 (progn
|
|
|
4020 (delete-region (match-beginning 2) (match-end 2))
|
|
|
4021 (insert (format "\"%d\"" columns)))
|
|
|
4022 (insert (format " colspan=\"%d\"" columns)))
|
|
|
4023 (error "ERROR: Point not in a table cell!")))))
|
|
0
|
4024
|
|
|
4025
|
|
|
4026 (defun hm--html-table-add-rowspan-attribute (rows)
|
|
|
4027 "Adds a rowspan attribute to a table cell.
|
|
|
4028 A prefix arg is used as no of ROWS."
|
|
|
4029 (interactive "NNo of rows, spaned by this cell: ")
|
|
98
|
4030 (let ((case-fold-search t))
|
|
|
4031 (save-excursion
|
|
|
4032 (if (and (search-backward "<" nil t)
|
|
|
4033 (search-forward-regexp "<[ \t\n]*\\(th\\)\\|\\(td\\)" nil t))
|
|
|
4034 (if (search-forward-regexp "\\([ \t\n]+rowspan=\\)\\([^ \t\n>]*\\)"
|
|
|
4035 nil
|
|
|
4036 t)
|
|
|
4037 (progn
|
|
|
4038 (delete-region (match-beginning 2) (match-end 2))
|
|
|
4039 (insert (format "\"%d\"" rows)))
|
|
|
4040 (insert (format " rowspan=\"%d\"" rows)))
|
|
|
4041 (error "ERROR: Point not in a table cell!")))))
|
|
0
|
4042
|
|
|
4043
|
|
|
4044 ;;; ISO-Characters for Emacs HTML-mode (Berthold Crysmann)
|
|
2
|
4045 ;(setq buffer-invisibility-spec '(hm--html-iso-entity-invisible-flag))
|
|
|
4046
|
|
|
4047 ;(defvar hm--html-iso-entity-invisible-flag t
|
|
|
4048 ; "Controls the visibility of the iso entities.")
|
|
|
4049
|
|
|
4050 ;(defvar hm--html-iso-glyph-invisible-flag nil
|
|
|
4051 ; "Controls the visibility of the iso character glyphs.")
|
|
|
4052
|
|
|
4053 ;(defvar hm--html-glyph-cache nil
|
|
|
4054 ; "Internal variable. An assoc list with the already created glyphs.")
|
|
|
4055
|
|
|
4056 ;(defun hm--html-create-glyph (string)
|
|
|
4057 ; "Creates a glyph from the string or returns an existing one.
|
|
|
4058 ;The glyph is stored in `hm--html-glyph-cache'."
|
|
|
4059 ; (if nil ;(assoc string hm--html-glyph-cache)
|
|
|
4060 ; (cdr (assoc string hm--html-glyph-cache))
|
|
|
4061 ; (let ((glyph (make-glyph string)))
|
|
|
4062 ; (setq hm--html-glyph-cache (cons (cons string glyph)
|
|
|
4063 ; hm--html-glyph-cache))
|
|
|
4064 ; glyph)))
|
|
|
4065
|
|
|
4066 ;(defun hm--html-attach-glyph-to-region (start
|
|
|
4067 ; end
|
|
|
4068 ; string
|
|
|
4069 ; region-invisible-flag
|
|
|
4070 ; glyph-invisible-flag)
|
|
|
4071 ; "Make the region invisible and attach a glyph STRING.
|
|
|
4072 ;The invisible flags could be used, to toggle the visibility."
|
|
|
4073 ; (mapcar 'delete-annotation (annotations-at end)) ; delete old anotations
|
|
|
4074 ; ;; delete old extents
|
|
|
4075 ; (let ((extent (make-extent start end))
|
|
|
4076 ; (annotation nil))
|
|
|
4077 ; (set-extent-property extent 'invisible region-invisible-flag)
|
|
|
4078 ; (set-extent-property extent 'end-open t)
|
|
|
4079 ; (set-extent-property extent 'start-open t)
|
|
|
4080 ; (set-extent-property extent 'intangible t)
|
|
|
4081 ; (setq annotation (make-annotation "Hallo Du da" ;(hm--html-create-glyph string)
|
|
|
4082 ; end
|
|
|
4083 ; 'text))
|
|
|
4084 ; (goto-char end)))
|
|
|
4085
|
|
|
4086
|
|
|
4087 ;(defun hm--html-insert-iso-char-as-entity-and-glyph (char entity)
|
|
|
4088 ; "Inserts an iso char as html ENTITY and displays a glyph.
|
|
|
4089 ;The glyph is created from the string CHAR."
|
|
|
4090 ; (let ((start (point)))
|
|
|
4091 ; (insert entity)
|
|
|
4092 ; (hm--html-attach-glyph-to-region start
|
|
|
4093 ; (point)
|
|
|
4094 ; char
|
|
|
4095 ; 'hm--html-iso-entity-invisible-flag
|
|
|
4096 ; 'hm--html-iso-glyph-invisible-flag)))
|
|
|
4097
|
|
|
4098 ;(defun hm--html_ue ()
|
|
|
4099 ; (interactive)
|
|
|
4100 ; (hm--html-insert-iso-char-as-entity-and-glyph "ü" "ü"))
|
|
|
4101
|
|
|
4102
|
|
|
4103 ;(defun hm--html-insert-iso-char-as-entity-and-glyph (char entity)
|
|
|
4104 ; (let ((start (point))
|
|
|
4105 ; (end nil)
|
|
|
4106 ; (extent nil))
|
|
|
4107 ; (insert entity)
|
|
|
4108 ; (setq end (point))
|
|
|
4109 ; (setq extent (make-extent start end))
|
|
|
4110 ; (set-extent-begin-glyph extent char)
|
|
|
4111 ; (set-extent-property extent 'invisible t)))
|
|
|
4112
|
|
|
4113 ;(defun hm--html_ue ()
|
|
|
4114 ; (interactive)
|
|
|
4115 ; (hm--html-insert-iso-char-as-entity-and-glyph ?ü "ü"))
|
|
0
|
4116
|
|
|
4117 (defun hm--html_ue ()
|
|
|
4118 "Insert the character 'ue'."
|
|
|
4119 (interactive)
|
|
|
4120 (insert "ü"))
|
|
|
4121
|
|
|
4122 (defun hm--html_oe ()
|
|
|
4123 "Insert the character 'oe'."
|
|
|
4124 (interactive)
|
|
|
4125 (insert "ö"))
|
|
|
4126
|
|
|
4127 (defun hm--html_ae ()
|
|
|
4128 "Insert the character 'ae'."
|
|
|
4129 (interactive)
|
|
|
4130 (insert "ä"))
|
|
|
4131
|
|
|
4132 (defun hm--html_aa ()
|
|
|
4133 "Insert the character 'aa'."
|
|
|
4134 (interactive)
|
|
|
4135 (insert "å"))
|
|
|
4136
|
|
|
4137 (defun hm--html_Ue ()
|
|
|
4138 "Insert the character 'Ue'."
|
|
|
4139 (interactive)
|
|
|
4140 (insert "Ü"))
|
|
|
4141
|
|
|
4142 (defun hm--html_Oe ()
|
|
|
4143 "Insert the character 'Oe'."
|
|
|
4144 (interactive)
|
|
|
4145 (insert "Ö"))
|
|
|
4146
|
|
|
4147 (defun hm--html_Ae ()
|
|
|
4148 "Insert the character 'Ae'."
|
|
|
4149 (interactive)
|
|
|
4150 (insert "Ä"))
|
|
|
4151
|
|
|
4152 (defun hm--html_Aa ()
|
|
|
4153 "Insert the character 'Aa'."
|
|
|
4154 (interactive)
|
|
|
4155 (insert "Å"))
|
|
|
4156
|
|
|
4157 (defun hm--html_sz ()
|
|
|
4158 "Insert the character 'sz'."
|
|
|
4159 (interactive)
|
|
|
4160 (insert "ß"))
|
|
|
4161
|
|
|
4162 (defun hm--html_aacute ()
|
|
|
4163 "Insert the character 'aacute'."
|
|
|
4164 (interactive)
|
|
|
4165 (insert "á"))
|
|
|
4166
|
|
|
4167 (defun hm--html_eacute ()
|
|
|
4168 "Insert the character 'eacute'."
|
|
|
4169 (interactive)
|
|
|
4170 (insert "é"))
|
|
|
4171
|
|
|
4172 (defun hm--html_iacute ()
|
|
|
4173 "Insert the character 'iacute'."
|
|
|
4174 (interactive)
|
|
|
4175 (insert "í"))
|
|
|
4176
|
|
|
4177 (defun hm--html_oacute ()
|
|
|
4178 "Insert the character 'oacute'."
|
|
|
4179 (interactive)
|
|
|
4180 (insert "ó"))
|
|
|
4181
|
|
|
4182 (defun hm--html_uacute ()
|
|
|
4183 "Insert the character 'uacute'."
|
|
|
4184 (interactive)
|
|
|
4185 (insert "ú"))
|
|
|
4186
|
|
|
4187 (defun hm--html_Aacute ()
|
|
|
4188 "Insert the character 'Aacute'."
|
|
|
4189 (interactive)
|
|
|
4190 (insert "á"))
|
|
|
4191
|
|
|
4192 (defun hm--html_Eacute ()
|
|
|
4193 "Insert the character 'Eacute'."
|
|
|
4194 (interactive)
|
|
|
4195 (insert "é"))
|
|
|
4196
|
|
|
4197 (defun hm--html_Iacute ()
|
|
|
4198 "Insert the character 'Iacute'."
|
|
|
4199 (interactive)
|
|
|
4200 (insert "í"))
|
|
|
4201
|
|
|
4202 (defun hm--html_Oacute ()
|
|
|
4203 "Insert the character 'Oacute'."
|
|
|
4204 (interactive)
|
|
|
4205 (insert "ó"))
|
|
|
4206
|
|
|
4207 (defun hm--html_Uacute ()
|
|
|
4208 "Insert the character 'Uacute'."
|
|
|
4209 (interactive)
|
|
|
4210 (insert "ú"))
|
|
|
4211
|
|
|
4212 (defun hm--html_agrave ()
|
|
|
4213 "Insert the character 'agrave'."
|
|
|
4214 (interactive)
|
|
|
4215 (insert "à"))
|
|
|
4216
|
|
|
4217 (defun hm--html_egrave ()
|
|
|
4218 "Insert the character 'egrave'."
|
|
|
4219 (interactive)
|
|
|
4220 (insert "è"))
|
|
|
4221
|
|
|
4222 (defun hm--html_igrave ()
|
|
|
4223 "Insert the character 'igrave'."
|
|
|
4224 (interactive)
|
|
|
4225 (insert "ì"))
|
|
|
4226
|
|
|
4227 (defun hm--html_ograve ()
|
|
|
4228 "Insert the character 'ograve'."
|
|
|
4229 (interactive)
|
|
|
4230 (insert "ò"))
|
|
|
4231
|
|
|
4232 (defun hm--html_ugrave ()
|
|
|
4233 "Insert the character 'ugrave'."
|
|
|
4234 (interactive)
|
|
|
4235 (insert "ù"))
|
|
|
4236
|
|
|
4237 (defun hm--html_Agrave ()
|
|
|
4238 "Insert the character 'Agrave'."
|
|
|
4239 (interactive)
|
|
|
4240 (insert "À"))
|
|
|
4241
|
|
|
4242 (defun hm--html_Egrave ()
|
|
|
4243 "Insert the character 'Egrave'."
|
|
|
4244 (interactive)
|
|
|
4245 (insert "È"))
|
|
|
4246
|
|
|
4247 (defun hm--html_Igrave ()
|
|
|
4248 "Insert the character 'Igrave'."
|
|
|
4249 (interactive)
|
|
|
4250 (insert "Ì"))
|
|
|
4251
|
|
|
4252 (defun hm--html_Ograve ()
|
|
|
4253 "Insert the character 'Ograve'."
|
|
|
4254 (interactive)
|
|
|
4255 (insert "Ò"))
|
|
|
4256
|
|
|
4257 (defun hm--html_Ugrave ()
|
|
|
4258 "Insert the character 'Ugrave'."
|
|
|
4259 (interactive)
|
|
|
4260 (insert "Ù"))
|
|
|
4261
|
|
|
4262 (defun hm--html_ccedilla ()
|
|
|
4263 "Insert the character 'ccedilla'."
|
|
|
4264 (interactive)
|
|
|
4265 (insert "çla;"))
|
|
|
4266
|
|
|
4267 (defun hm--html_Ccedilla ()
|
|
|
4268 "Insert the character 'Ccedilla'."
|
|
|
4269 (interactive)
|
|
|
4270 (insert "Çla;"))
|
|
|
4271
|
|
|
4272 (defun hm--html_atilde ()
|
|
|
4273 "Insert the character 'atilde'."
|
|
|
4274 (interactive)
|
|
|
4275 (insert "ã"))
|
|
|
4276
|
|
|
4277 (defun hm--html_otilde ()
|
|
|
4278 "Insert the character 'otilde'."
|
|
|
4279 (interactive)
|
|
|
4280 (insert "õ"))
|
|
|
4281
|
|
|
4282 (defun hm--html_ntilde ()
|
|
|
4283 "Insert the character 'ntilde'."
|
|
|
4284 (interactive)
|
|
|
4285 (insert "ñ"))
|
|
|
4286
|
|
|
4287 (defun hm--html_Atilde ()
|
|
|
4288 "Insert the character 'Atilde'."
|
|
|
4289 (interactive)
|
|
|
4290 (insert "Ã"))
|
|
|
4291
|
|
|
4292 (defun hm--html_Otilde ()
|
|
|
4293 "Insert the character 'Otilde'."
|
|
|
4294 (interactive)
|
|
|
4295 (insert "Õ"))
|
|
|
4296
|
|
|
4297 (defun hm--html_Ntilde ()
|
|
|
4298 "Insert the character 'Ntilde'."
|
|
|
4299 (interactive)
|
|
|
4300 (insert "Ñ"))
|
|
|
4301
|
|
|
4302 (defun hm--html_acircumflex ()
|
|
|
4303 "Insert the character 'acircumflex'."
|
|
|
4304 (interactive)
|
|
|
4305 (insert "âumflex;"))
|
|
|
4306
|
|
|
4307 (defun hm--html_ecircumflex ()
|
|
|
4308 "Insert the character 'ecircumflex'."
|
|
|
4309 (interactive)
|
|
|
4310 (insert "êumflex;"))
|
|
|
4311
|
|
|
4312 (defun hm--html_icircumflex ()
|
|
|
4313 "Insert the character 'icircumflex'."
|
|
|
4314 (interactive)
|
|
|
4315 (insert "îumflex;"))
|
|
|
4316
|
|
|
4317 (defun hm--html_ocircumflex ()
|
|
|
4318 "Insert the character 'ocircumflex'."
|
|
|
4319 (interactive)
|
|
|
4320 (insert "ôumflex;"))
|
|
|
4321
|
|
|
4322 (defun hm--html_ucircumflex ()
|
|
|
4323 "Insert the character 'ucircumflex'."
|
|
|
4324 (interactive)
|
|
|
4325 (insert "ûumflex;"))
|
|
|
4326
|
|
|
4327 (defun hm--html_Acircumflex ()
|
|
|
4328 "Insert the character 'Acircumflex'."
|
|
|
4329 (interactive)
|
|
|
4330 (insert "Âumflex;"))
|
|
|
4331
|
|
|
4332 (defun hm--html_Ecircumflex ()
|
|
|
4333 "Insert the character 'Ecircumflex'."
|
|
|
4334 (interactive)
|
|
|
4335 (insert "Êumflex;"))
|
|
|
4336
|
|
|
4337 (defun hm--html_Icircumflex ()
|
|
|
4338 "Insert the character 'Icircumflex'."
|
|
|
4339 (interactive)
|
|
|
4340 (insert "Îumflex;"))
|
|
|
4341
|
|
|
4342 (defun hm--html_Ocircumflex ()
|
|
|
4343 "Insert the character 'Ocircumflex'."
|
|
|
4344 (interactive)
|
|
|
4345 (insert "Ôumflex;"))
|
|
|
4346
|
|
|
4347 (defun hm--html_Ucircumflex ()
|
|
|
4348 "Insert the character 'Ucircumflex'."
|
|
|
4349 (interactive)
|
|
|
4350 (insert "Ûumflex;"))
|
|
|
4351
|
|
|
4352 (defun hm--html_ediaeresis ()
|
|
|
4353 "Insert the character 'ediaeresis'."
|
|
|
4354 (interactive)
|
|
|
4355 (insert "ë"))
|
|
|
4356
|
|
|
4357 (defun hm--html_idiaeresis ()
|
|
|
4358 "Insert the character 'idiaeresis'."
|
|
|
4359 (interactive)
|
|
|
4360 (insert "ï"))
|
|
|
4361
|
|
|
4362 (defun hm--html_Ediaeresis ()
|
|
|
4363 "Insert the character 'Ediaeresis'."
|
|
|
4364 (interactive)
|
|
|
4365 (insert "Ë"))
|
|
|
4366
|
|
|
4367 (defun hm--html_Idiaeresis ()
|
|
|
4368 "Insert the character 'Idiaeresis'."
|
|
|
4369 (interactive)
|
|
|
4370 (insert "Ï"))
|
|
|
4371
|
|
|
4372 (defun hm--html_thorn ()
|
|
|
4373 "Insert the character 'thorn'."
|
|
|
4374 (interactive)
|
|
|
4375 (insert "þ"))
|
|
|
4376
|
|
|
4377 (defun hm--html_Thorn ()
|
|
|
4378 "Insert the character 'Thorn'."
|
|
|
4379 (interactive)
|
|
|
4380 (insert "Þ"))
|
|
|
4381
|
|
|
4382 (defun hm--html_eth ()
|
|
|
4383 "Insert the character 'eth'."
|
|
|
4384 (interactive)
|
|
|
4385 (insert "ð"))
|
|
|
4386
|
|
|
4387 (defun hm--html_Eth ()
|
|
|
4388 "Insert the character 'Eth'."
|
|
|
4389 (interactive)
|
|
|
4390 (insert "Ð"))
|
|
|
4391
|
|
|
4392
|
|
|
4393 ;;;
|
|
|
4394 ;
|
|
|
4395 ; smart functions
|
|
|
4396
|
|
|
4397 (defvar hm--just-insert-less-than nil
|
|
|
4398 "Internal variable.")
|
|
|
4399
|
|
2
|
4400 (defun hm--html-less-than ()
|
|
|
4401 "Inserts the entity '>'."
|
|
|
4402 (interactive)
|
|
|
4403 (insert "<"))
|
|
|
4404
|
|
0
|
4405 (defun hm--html-smart-less-than ()
|
|
|
4406 "Insert a '<' or the entity '<' if you execute this command twice."
|
|
|
4407 (interactive)
|
|
|
4408 (if (and (eq last-command 'hm--html-smart-less-than)
|
|
|
4409 hm--just-insert-less-than)
|
|
|
4410 (progn
|
|
|
4411 (delete-char -1)
|
|
2
|
4412 (hm--html-less-than)
|
|
0
|
4413 (setq hm--just-insert-less-than nil))
|
|
|
4414 (insert ?<)
|
|
|
4415 (setq hm--just-insert-less-than t)))
|
|
|
4416
|
|
|
4417 (defvar hm--just-insert-greater-than nil
|
|
|
4418 "Internal variable.")
|
|
|
4419
|
|
2
|
4420 (defun hm--html-greater-than ()
|
|
|
4421 "Inserts the entity '>'."
|
|
|
4422 (interactive)
|
|
|
4423 (insert ">"))
|
|
|
4424
|
|
0
|
4425 (defun hm--html-smart-greater-than ()
|
|
|
4426 "Insert a '>' or the entity '>' if you execute this command twice."
|
|
|
4427 (interactive)
|
|
|
4428 (if (and (eq last-command 'hm--html-smart-greater-than)
|
|
|
4429 hm--just-insert-greater-than)
|
|
|
4430 (progn
|
|
|
4431 (delete-char -1)
|
|
2
|
4432 (hm--html-greater-than)
|
|
0
|
4433 (setq hm--just-insert-greater-than nil))
|
|
|
4434 (insert ?>)
|
|
|
4435 (setq hm--just-insert-greater-than t)))
|
|
|
4436
|
|
|
4437
|
|
2
|
4438 (defvar hm--just-insert-ampersand nil
|
|
|
4439 "Internal variable.")
|
|
|
4440
|
|
|
4441 (defun hm--html-ampersand ()
|
|
|
4442 "Inserts the entity '&'."
|
|
|
4443 (interactive)
|
|
|
4444 (insert "&"))
|
|
|
4445
|
|
|
4446 (defun hm--html-smart-ampersand ()
|
|
|
4447 "Insert a '&' or the entity '&' if you execute this command twice."
|
|
|
4448 (interactive)
|
|
|
4449 (if (and (eq last-command 'hm--html-smart-ampersand)
|
|
|
4450 hm--just-insert-ampersand)
|
|
|
4451 (progn
|
|
|
4452 (delete-char -1)
|
|
|
4453 (hm--html-ampersand)
|
|
|
4454 (setq hm--just-insert-ampersand nil))
|
|
|
4455 (insert ?&)
|
|
|
4456 (setq hm--just-insert-ampersand t)))
|
|
|
4457
|
|
|
4458
|
|
0
|
4459 ;;;
|
|
|
4460 ; sending the contents of a html buffer to netscape
|
|
|
4461 ; (Thanks to Adrian Aichner for providing this function)
|
|
|
4462
|
|
|
4463 (defun hm--html-send-buffer-to-netscape (buffer
|
|
|
4464 &optional new-netscape new-window)
|
|
|
4465 "View html buffer with Netscape.
|
|
|
4466 This should be changed in the fututure, so that it doesn't need vm."
|
|
|
4467 (interactive)
|
|
|
4468 (require 'vm)
|
|
|
4469 (if new-netscape
|
|
|
4470 (vm-run-background-command vm-netscape-program buffer-file-name)
|
|
|
4471 (or (equal 0
|
|
|
4472 (vm-run-command vm-netscape-program
|
|
|
4473 "-remote"
|
|
|
4474 (concat "openURL(file://localhost"
|
|
|
4475 buffer-file-name
|
|
|
4476 (if new-window ", new-window" "")
|
|
|
4477 ")")))
|
|
|
4478 (hm--html-send-buffer-to-netscape buffer t new-window))))
|
|
|
4479
|
|
|
4480
|
|
|
4481
|
|
|
4482 ;;;
|
|
|
4483 ; some other usefull functions
|
|
|
4484 ;
|
|
|
4485
|
|
|
4486 (defun hm--html-remove-numeric-names ()
|
|
|
4487 "Remove the number in numbered links in the current buffer.
|
|
|
4488 Eg: the string \"Name=3\". The function asks the user every time whether
|
|
|
4489 the number should be removed."
|
|
|
4490 (interactive)
|
|
|
4491 (save-excursion
|
|
|
4492 (goto-char (point-min))
|
|
|
4493 (query-replace-regexp "name=\"?[0-9]+\"?+[ \t]*" "")))
|
|
|
4494
|
|
|
4495 ;;This should be extended in the future to use also other viewers.
|
|
|
4496 (defun hm--html-view-www-package-docu ()
|
|
|
4497 "View the WWW documentation of the package."
|
|
|
4498 (interactive)
|
|
70
|
4499 (w3-fetch "http://www.tnt.uni-hannover.de:80/data/info/www/tnt/soft/info/www/html-editors/hm--html-menus/overview.html"))
|
|
0
|
4500
|
|
|
4501 ;;;
|
|
|
4502 ; Bug reporting
|
|
|
4503 ;
|
|
|
4504
|
|
|
4505 (defun hm--html-submit-bug-report ()
|
|
|
4506 "Submit via mail a bug report on hm--html-menus."
|
|
|
4507 (interactive)
|
|
|
4508 (require 'reporter)
|
|
|
4509 (let ((reporter-prompt-for-summary-p t))
|
|
|
4510 (reporter-submit-bug-report
|
|
|
4511 hm--html-menus-package-maintainer
|
|
|
4512 (concat hm--html-menus-package-name
|
|
|
4513 " "
|
|
|
4514 hm--html-menus-package-version)
|
|
|
4515 (list 'emacs-version
|
|
|
4516 'major-mode
|
|
|
4517 'hm--html-automatic-changed-comment
|
|
|
4518 'hm--html-automatic-created-comment
|
|
|
4519 'hm--html-automatic-expand-templates
|
|
|
4520 'hm--html-automatic-new-date
|
|
|
4521 'hm--html-expert
|
|
|
4522 'hm--html-favorite-http-server-host-name
|
|
|
4523 'hm--html-file-path-alist
|
|
|
4524 'hm--html-ftp-hostname:port-alist
|
|
|
4525 'hm--html-ftp-hostname:port-default
|
|
|
4526 'hm--html-ftp-path-alist
|
|
|
4527 'hm--html-gopher-anchor-alist
|
|
|
4528 'hm--html-gopher-doctype-alist
|
|
|
4529 'hm--html-gopher-doctype-default
|
|
|
4530 'hm--html-gopher-hostname:port-alist
|
|
|
4531 'hm--html-gopher-hostname:port-default
|
|
|
4532 'hm--html-html-hostname:port-alist
|
|
|
4533 'hm--html-html-hostname:port-default
|
|
|
4534 'hm--html-html-path-alist
|
|
|
4535 'hm--html-info-hostname:port-alist
|
|
|
4536 'hm--html-info-hostname:port-default
|
|
|
4537 'hm--html-info-path-alist
|
|
|
4538 'hm--html-local-proggate-path-alist
|
|
|
4539 'hm--html-mail-hostname:port-alist
|
|
|
4540 'hm--html-mail-hostname:port-default
|
|
|
4541 'hm--html-mail-path-alist
|
|
|
4542 'hm--html-marc
|
|
|
4543 'hm--html-menu-load-hook
|
|
|
4544 'hm--html-proggate-allowed-file
|
|
|
4545 'hm--html-proggate-hostname:port-alist
|
|
|
4546 'hm--html-proggate-hostname:port-default
|
|
|
4547 'hm--html-server-side-include-command-alist
|
|
|
4548 'hm--html-server-side-include-command-with-parameter-alist
|
|
|
4549 'hm--html-signature-file
|
|
|
4550 'hm--html-template-dir
|
|
|
4551 'hm--html-url-alist
|
|
|
4552 'hm--html-user-config-file
|
|
98
|
4553 'hm--html-site-config-file
|
|
0
|
4554 'hm--html-username
|
|
|
4555 'hm--html-wais-hostname:port-alist
|
|
|
4556 'hm--html-wais-hostname:port-default
|
|
|
4557 'hm--html-wais-path-alist
|
|
|
4558 'hm--html-wais-servername:port-alist
|
|
|
4559 'hm--html-wais-servername:port-default
|
|
70
|
4560 ; 'html-deemphasize-color
|
|
0
|
4561 'html-document-previewer
|
|
70
|
4562 ; 'html-document-previewer-args
|
|
|
4563 ; 'html-emphasize-color
|
|
|
4564 ; 'html-quotify-hrefs-on-find
|
|
2
|
4565 'hm--html-region-mode
|
|
0
|
4566 'html-sigusr1-signal-value
|
|
70
|
4567 ; 'html-use-font-lock
|
|
|
4568 ; 'html-use-highlighting
|
|
0
|
4569 )
|
|
|
4570 nil
|
|
|
4571 nil
|
|
|
4572 "Decribe your Bug: "
|
|
|
4573 )))
|
|
|
4574
|
|
|
4575
|
|
|
4576 ;;;
|
|
|
4577 ; hook adding functions
|
|
|
4578 ;
|
|
|
4579
|
|
|
4580 (if (adapt-xemacsp)
|
|
|
4581 (progn
|
|
|
4582
|
|
2
|
4583 (add-hook 'zmacs-activate-region-hook
|
|
|
4584 'hm--html-switch-region-modes-on)
|
|
70
|
4585 ; (function (lambda () (hm--html-region-mode 1))))
|
|
0
|
4586
|
|
|
4587 (add-hook 'zmacs-deactivate-region-hook
|
|
2
|
4588 'hm--html-switch-region-modes-off)
|
|
70
|
4589 ; (function (lambda () (hm--html-region-mode -1))))
|
|
0
|
4590
|
|
|
4591 )
|
|
|
4592
|
|
|
4593 (transient-mark-mode t)
|
|
|
4594
|
|
|
4595 (add-hook 'activate-mark-hook
|
|
2
|
4596 'hm--html-switch-region-modes-on)
|
|
70
|
4597 ; (function (lambda () (hm--html-region-mode t))))
|
|
0
|
4598
|
|
|
4599 (add-hook 'deactivate-mark-hook
|
|
2
|
4600 'hm--html-switch-region-modes-off)
|
|
70
|
4601 ; (function (lambda () (hm--html-region-mode nil))))
|
|
0
|
4602
|
|
|
4603 )
|
|
|
4604
|
|
|
4605
|
|
70
|
4606 ;(add-hook 'hm--html-mode-hook
|
|
|
4607 ; (function
|
|
|
4608 ; (lambda ()
|
|
|
4609 ; (make-variable-buffer-local 'write-file-hooks)
|
|
|
4610 ; (add-hook 'write-file-hooks
|
|
|
4611 ; 'hm--html-maybe-new-date-and-changed-comment))))
|
|
|
4612
|
|
|
4613 ;(add-hook 'zmacs-activate-region-hook 'hm--set-hm--region-active)
|
|
|
4614 ;
|
|
|
4615 ;(add-hook 'zmacs-deactivate-region-hook 'hm--unset-hm--region-active)
|
|
|
4616
|
|
|
4617
|
|
|
4618
|
|
0
|
4619 ;;;
|
|
|
4620 ; Environment loading
|
|
|
4621 ;
|
|
|
4622
|
|
|
4623 (defun hm--html-load-config-files ()
|
|
|
4624 "Load the html configuration files.
|
|
|
4625 First, the system config file (detemined by the environment variable
|
|
98
|
4626 HTML_CONFIG_FILE; normaly hm--html-configuration.el(c)) is loaded.
|
|
|
4627 At second a site config file is loaded, if the environment variable
|
|
|
4628 HTML_SITE_CONFIG_FILE or the lisp variable `hm--html-site-config-file'
|
|
|
4629 is set to such a file.
|
|
|
4630 At least the user config file (determined by the environment variable
|
|
0
|
4631 HTML_USER_CONFIG_FILE; normaly the file ~/.hm--html-configuration.el(c)).
|
|
|
4632 If no HTML_CONFIG_FILE exists, then the file hm--html-configuration.el(c)
|
|
|
4633 is searched in one of the lisp load path directories.
|
|
|
4634 If no HTML_USER_CONFIG_FILE exists, then the variable
|
|
|
4635 `hm--html-user-config-file' is checked. If this variable is nil or the file
|
|
|
4636 also doesn't exist, then the file ~/.hm--html-configuration.el(c) is used."
|
|
|
4637 (interactive)
|
|
|
4638 ;; at first the system config file
|
|
|
4639 (if (and (stringp (getenv "HTML_CONFIG_FILE"))
|
|
|
4640 (file-exists-p
|
|
|
4641 (expand-file-name
|
|
|
4642 (getenv "HTML_CONFIG_FILE"))))
|
|
|
4643 (load-library (expand-file-name (getenv "HTML_CONFIG_FILE")))
|
|
|
4644 (load-library "hm--html-configuration"))
|
|
98
|
4645
|
|
|
4646 ;; at second the site config file
|
|
|
4647 (if (and (stringp (getenv "HTML_SITE_CONFIG_FILE"))
|
|
|
4648 (file-exists-p
|
|
|
4649 (expand-file-name
|
|
|
4650 (getenv "HTML_SITE_CONFIG_FILE"))))
|
|
|
4651 (load-file (expand-file-name (getenv "HTML_SITE_CONFIG_FILE")))
|
|
|
4652 (when (and (boundp 'hm--html-site-config-file)
|
|
|
4653 (stringp hm--html-site-config-file)
|
|
|
4654 (file-exists-p (expand-file-name hm--html-site-config-file)))
|
|
|
4655 (load-file (expand-file-name hm--html-site-config-file))))
|
|
0
|
4656
|
|
|
4657 ;; and now the user config file
|
|
|
4658 (cond ((and (stringp (getenv "HTML_USER_CONFIG_FILE"))
|
|
|
4659 (file-exists-p
|
|
|
4660 (expand-file-name
|
|
|
4661 (getenv "HTML_USER_CONFIG_FILE"))))
|
|
|
4662 (load-file (expand-file-name (getenv "HTML_USER_CONFIG_FILE"))))
|
|
|
4663 ((and (boundp 'hm--html-user-config-file)
|
|
|
4664 (stringp hm--html-user-config-file)
|
|
|
4665 (file-exists-p (expand-file-name hm--html-user-config-file)))
|
|
|
4666 (load-file (expand-file-name hm--html-user-config-file)))
|
|
|
4667 ((file-exists-p (expand-file-name "~/.hm--html-configuration.elc"))
|
|
|
4668 (load-file (expand-file-name "~/.hm--html-configuration.elc")))
|
|
|
4669 ((file-exists-p (expand-file-name "~/.hm--html-configuration.el"))
|
|
|
4670 (load-file (expand-file-name "~/.hm--html-configuration.el")))
|
|
|
4671 (t
|
|
|
4672 (message (concat "WARNING: No HTML User Config File ! "
|
|
|
4673 "Look at hm--html-load-config-files !")))
|
|
|
4674 )
|
|
|
4675 )
|
|
|
4676
|
|
|
4677
|
|
70
|
4678
|
|
|
4679 ;(hm--html-load-config-files)
|
|
|
4680
|
|
|
4681 ;;; Definition of the minor mode html-region-mode
|
|
|
4682
|
|
|
4683 ;(defvar html-region-mode nil
|
|
|
4684 ; "*t, if the minor mode html-region-mode is on and nil otherwise.")
|
|
|
4685
|
|
|
4686 ;(make-variable-buffer-local 'html-region-mode)
|
|
|
4687
|
|
|
4688 ;(defvar html-region-mode-map nil "")
|
|
|
4689
|
|
|
4690 ;(hm--html-load-config-files)
|
|
|
4691
|
|
|
4692 ;(if hm--html-use-old-keymap
|
|
|
4693 ; (progn
|
|
|
4694
|
|
|
4695 ;;(setq minor-mode-alist (cons '(html-region-mode " Region") minor-mode-alist))
|
|
|
4696 ;(or (assq 'html-region-mode minor-mode-alist)
|
|
|
4697 ; (setq minor-mode-alist
|
|
|
4698 ; (purecopy
|
|
|
4699 ; (append minor-mode-alist
|
|
|
4700 ; '((html-region-mode " Region"))))))
|
|
|
4701
|
|
|
4702 ;(defun html-region-mode (on)
|
|
|
4703 ; "Turns the minor mode html-region-mode on or off.
|
|
|
4704 ;The function turns the html-region-mode on, if ON is t and off otherwise."
|
|
|
4705 ; (if (string= mode-name "HTML")
|
|
|
4706 ; (if on
|
|
|
4707 ; ;; html-region-mode on
|
|
|
4708 ; (progn
|
|
|
4709 ; (setq html-region-mode t)
|
|
|
4710 ; (use-local-map html-region-mode-map))
|
|
|
4711 ; ;; html-region-mode off
|
|
|
4712 ; (setq html-region-mode nil)
|
|
|
4713 ; (use-local-map html-mode-map))))
|
|
|
4714
|
|
|
4715 ;))
|
|
|
4716
|
|
|
4717
|
|
|
4718
|
|
|
4719
|
|
|
4720
|
|
|
4721 ;;;
|
|
|
4722 ; Set font lock color
|
|
|
4723 ; (hm--html-font-lock-color should be defined in hm--html-configuration.el
|
|
|
4724 ; oder .hm--html-configuration.el)
|
|
|
4725 ;
|
|
|
4726 ;(require 'font-lock)
|
|
|
4727 ;(load-library "font-lock")
|
|
|
4728 ;(set-face-foreground 'font-lock-comment-face hm--html-font-lock-color)
|
|
|
4729
|
|
|
4730
|
|
|
4731 ;(hm--html-generate-help-buffer-faces)
|
|
|
4732
|
|
|
4733
|
|
|
4734
|
|
|
4735
|
|
|
4736 ;;;;;;;;
|
|
|
4737 ;(setq hm--html-hostname-search-string
|
|
|
4738 ; "[-a-zA-Z0-9]*\\.[-a-zA-Z0-9]*\\.[-a-zA-Z0-9.]*")
|
|
|
4739 ;
|
|
|
4740 ;(defun hm--html-get-next-hostname ()
|
|
|
4741 ; (interactive)
|
|
|
4742 ; (search-forward-regexp hm--html-hostname-search-string)
|
|
|
4743 ; (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
4744 ;
|
|
|
4745
|
|
|
4746 ;;; Announce the feature hm--html-configuration
|
|
|
4747
|
|
2
|
4748 ;;; quotify href
|
|
|
4749
|
|
|
4750 (defvar hm--html-quotify-href-regexp
|
|
|
4751 "<[aA][ \t\n]+\\([nN][aA][mM][eE]=[a-zA-Z0-9]+[ \t\n]+\\)?[hH][rR][eE][fF]="
|
|
|
4752 "Regular expression used for searching hrefs.")
|
|
|
4753
|
|
|
4754 (defun hm--html-quotify-hrefs ()
|
|
|
4755 "Insert quotes around all HREF and NAME attribute value literals.
|
|
|
4756
|
|
|
4757 This remedies the problem with old HTML files that can't be processed
|
|
|
4758 by SGML parsers. That is, changes <A HREF=foo> to <A HREF=\"foo\">.
|
|
|
4759
|
|
|
4760 Look also at the variable `hm--html-quotify-href-regexp'."
|
|
|
4761 (interactive)
|
|
|
4762 (save-excursion
|
|
|
4763 (goto-char (point-min))
|
|
|
4764 (while
|
|
|
4765 (re-search-forward hm--html-quotify-href-regexp
|
|
|
4766 (point-max)
|
|
|
4767 t)
|
|
|
4768 (cond
|
|
|
4769 ((null (looking-at "\""))
|
|
|
4770 (insert "\"")
|
|
|
4771 (re-search-forward "[ \t\n>]" (point-max) t)
|
|
|
4772 (forward-char -1)
|
|
|
4773 (insert "\""))))))
|
|
|
4774
|
|
|
4775
|
|
|
4776
|
|
|
4777 (provide 'hm--html)
|
