0
|
1 ;;; hm--html.el:
|
|
2 ;;; v6.00; 17 Feb 1996
|
|
3 ;;; Copyright (C) 1993, 1994, 1995, 1996 Heiko Muenkel
|
|
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
|
|
30
|
|
31
|
|
32 (provide 'hm--html)
|
|
33 (require 'hm--date)
|
|
34 (require 'adapt)
|
|
35
|
|
36
|
|
37 (defconst hm--html-menus-package-maintainer "muenkel@tnt.uni-hannover.de")
|
|
38
|
|
39 (defconst hm--html-menus-package-name "hm--html-menus")
|
|
40
|
|
41 (defconst hm--html-menus-package-version "4.16")
|
|
42
|
|
43
|
|
44 ;;; Functions for adding html commands which consists of a start and a
|
|
45 ;;; end tag and some text between them. (Basicfunctions)
|
|
46
|
|
47 (defun hm--html-add-tags (function-insert-start-tag
|
|
48 start-tag
|
|
49 &optional function-insert-end-tag
|
|
50 &optional end-tag
|
|
51 &optional function-insert-middle-tag
|
|
52 &optional middle-tag)
|
|
53 "Adds the start and the end html tag at point.
|
|
54 The first parameter specifies the funtion which insert the start tag
|
|
55 and the third parameter specifies the function which insert the end tag.
|
|
56 The second parameter is the string for the start tag and the fourth parameter
|
|
57 is the string for the end tag. The third and fourth parameters are optional.
|
|
58 The fifth parameter is optional. If it exists, it specifies a function which
|
|
59 inserts the sixth parameter (the middle-tag) between the start and the end
|
|
60 tag."
|
|
61 ; (interactive "aFunction, which adds the HTML start tag: \n\
|
|
62 ;aFunction, which adds the HTML end tag: \n\
|
|
63 ;sThe HTML start tag: \n\
|
|
64 ;sThe HTML end tag: ")
|
|
65 (eval (list function-insert-start-tag start-tag))
|
|
66 (if function-insert-middle-tag
|
|
67 (eval (list function-insert-middle-tag middle-tag)))
|
|
68 (if function-insert-end-tag
|
|
69 (let ((position (point)))
|
|
70 (eval (list function-insert-end-tag end-tag))
|
|
71 (goto-char position))))
|
|
72
|
|
73
|
|
74 (defun hm--html-add-tags-to-region (function-insert-start-tag
|
|
75 start-tag
|
|
76 function-insert-end-tag
|
|
77 end-tag
|
|
78 &optional function-insert-middle-tag
|
|
79 &optional middle-tag)
|
|
80 "Adds the start and the end html tag to the active region.
|
|
81 The first parameter specifies the funtion which insert the start tag
|
|
82 and the third parameter specifies the function which insert the end tag.
|
|
83 The second parameter is the string for the start tag and the fourth parameter
|
|
84 is the string for the end tag.
|
|
85 The fifth parameter is optional. If it exists, it specifies a function which
|
|
86 inserts the sixth parameter (the middle-tag) between the start and the end
|
|
87 tag."
|
|
88 ; (interactive "aFunction, which adds the html start tag: \n\
|
|
89 ;aFunction, which adds the html end tag: \n\
|
|
90 ;sThe HTML start tag: \n\
|
|
91 ;sThe HTML end tag: ")
|
|
92 (save-window-excursion
|
|
93 (let ((start (region-beginning))
|
|
94 (end (region-end)))
|
|
95 (goto-char end)
|
|
96 (eval (list function-insert-end-tag end-tag))
|
|
97 (goto-char start)
|
|
98 (eval (list function-insert-start-tag start-tag))
|
|
99 (if function-insert-middle-tag
|
|
100 (eval (list function-insert-middle-tag middle-tag)))
|
|
101 )))
|
|
102
|
|
103
|
|
104 (defun hm--html-insert-start-tag (tag)
|
|
105 "Inserts the HTML start tag 'tag' without a Newline.
|
|
106 The parameter must be a string (i.e. \"<B>\")"
|
|
107 (let ((start (point)))
|
|
108 (insert tag)
|
|
109 (html-maybe-deemphasize-region start (- (point) 1))))
|
|
110
|
|
111
|
|
112 (defun hm--html-insert-end-tag (tag)
|
|
113 "Inserts the HTML end tag 'tag' without a Newline.
|
|
114 The parameter must be a string (i.e. \"</B>\")"
|
|
115 (let ((start (point)))
|
|
116 (insert tag)
|
|
117 (html-maybe-deemphasize-region start (- (point) 1))))
|
|
118
|
|
119
|
|
120 (defun hm--html-insert-start-tag-with-newline (tag)
|
|
121 "Inserts the HTML start tag 'tag' with a Newline.
|
|
122 The parameter must be a string (i.e. \"<PRE>\")"
|
|
123 (let ((start (point)))
|
|
124 (insert tag)
|
|
125 (html-maybe-deemphasize-region start (- (point) 1)))
|
|
126 (insert "\n"))
|
|
127
|
|
128
|
|
129 (defun hm--html-insert-end-tag-with-newline (tag)
|
|
130 "Inserts the HTML end tag 'tag' with a Newline.
|
|
131 The parameter must be a string (i.e. \"</PRE>\")"
|
|
132 (insert "\n")
|
|
133 (let ((start (point)))
|
|
134 (insert tag)
|
|
135 (html-maybe-deemphasize-region start (- (point) 1))))
|
|
136
|
|
137
|
|
138
|
|
139 ;;; Functions which add simple tags of the form <tag>
|
|
140
|
|
141 (defun hm--html-add-line-break ()
|
|
142 "Adds the HTML tag for a line break."
|
|
143 (interactive)
|
|
144 (hm--html-add-tags 'hm--html-insert-start-tag "<BR>"))
|
|
145
|
|
146
|
|
147 (defun hm--html-add-horizontal-rule ()
|
|
148 "Adds the HTML tag for a horizontal rule (line)."
|
|
149 (interactive)
|
|
150 (hm--html-add-tags 'hm--html-insert-start-tag "<HR>"))
|
|
151
|
|
152
|
|
153 (defun hm--html-add-paragraph ()
|
|
154 "Adds the HTML tags for a paragraph at the point in the current buffer."
|
|
155 (interactive)
|
|
156 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
157 "<P>"
|
|
158 'hm--html-insert-end-tag-with-newline
|
|
159 "</P>"))
|
|
160
|
|
161
|
|
162 (defun hm--html-add-paragraph-to-region ()
|
|
163 "Adds the HTML tags for a paragraph to the region."
|
|
164 (interactive)
|
|
165 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
166 "<P>"
|
|
167 'hm--html-insert-end-tag-with-newline
|
|
168 "</P>"))
|
|
169
|
|
170
|
|
171 (defun hm--html-add-paragraph-separator ()
|
|
172 "Adds the tag for a paragraph seperator."
|
|
173 (interactive)
|
|
174 (hm--html-add-tags 'hm--html-insert-start-tag "<P>"))
|
|
175
|
|
176
|
|
177
|
|
178 ;;; Functions which include something in HTML- documents
|
|
179
|
|
180 (defvar hm--html-url-history-list nil
|
|
181 "History list for the function 'hm--html-read-url'")
|
|
182
|
|
183
|
|
184 (defun hm--html-read-url-predicate (table-element-list usagesymbol)
|
|
185 "Predicatefunction for hm--html-read-url."
|
|
186 (hm--html-read-url-predicate-1 (cdr table-element-list) usagesymbol))
|
|
187
|
|
188
|
|
189 (defun hm--html-read-url-predicate-1 (table-element-list usagesymbol)
|
|
190 "Internal function of hm--html-read-url-predicate."
|
|
191 (cond ((not table-element-list) nil)
|
|
192 ((eq (car table-element-list) usagesymbol))
|
|
193 (t (hm--html-read-url-predicate-1 (cdr table-element-list)
|
|
194 usagesymbol))))
|
|
195
|
|
196
|
|
197 (defun hm--html-read-url (prompt &optional
|
|
198 table
|
|
199 predicate
|
|
200 require-match
|
|
201 initial-contents)
|
|
202 "Function prompts for a URL string.
|
|
203 TABLE is an alist whose elements' cars are URL's.
|
|
204 PREDICATE limits completion to a subset of TABLE.
|
|
205 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
|
|
206 the input is (or completes to) an element of TABLE.
|
|
207 INITIAL-CONTENTS is a string to insert in the minibuffer before reading.
|
|
208 If INITIAL-CONTENTS is nil, the car of the 'hm--html-url-history-list'
|
|
209 is used instead."
|
|
210 (if table
|
|
211 (completing-read prompt
|
|
212 table
|
|
213 predicate
|
|
214 require-match
|
|
215 initial-contents
|
|
216 hm--html-url-history-list)
|
|
217 (read-string prompt
|
|
218 (if initial-contents
|
|
219 initial-contents
|
|
220 (car hm--html-url-history-list))
|
|
221 hm--html-url-history-list)))
|
|
222
|
|
223
|
|
224 (defun hm--html-read-altenate (url)
|
|
225 "Function reads the value for the \"ALT\"- attribute in IMG tags.
|
|
226 URL will be used as the default URL for the external viewer."
|
|
227 (let ((alttype
|
|
228 (string-to-int
|
|
229 (completing-read
|
|
230 ; "0: No ALT atribute, 1: ALT=\"\", 2: ALT=Text, 3: ALT=External Viewer: "
|
|
231 "0: No ALT atribute, 1: ALT=\"\", 2: ALT=Text: "
|
|
232 ; '(("0") ("1") ("2") ("3"))
|
|
233 '(("0") ("1") ("2"))
|
|
234 nil
|
|
235 t
|
|
236 "2"))))
|
|
237 (cond ((= alttype 0) nil)
|
|
238 ((= alttype 1) "")
|
|
239 ((= alttype 2) (read-string
|
|
240 "Text for the ALT attribute: "
|
|
241 (substring (file-name-nondirectory url)
|
|
242 0
|
|
243 (string-match
|
|
244 "\\."
|
|
245 (file-name-nondirectory url)))))
|
|
246 ; ((= alttype 3) (concat "<A HREF=\""
|
|
247 ; url
|
|
248 ; "\">"
|
|
249 ; (file-name-nondirectory url)
|
|
250 ; "</A>"))
|
|
251 )))
|
|
252
|
|
253
|
|
254 (defun hm--html-add-image-bottom (href alt)
|
|
255 "Add an image, bottom aligned."
|
|
256 (interactive (let ((url (hm--html-read-url "Image URL: ")))
|
|
257 (list url (hm--html-read-altenate url))))
|
|
258 (let ((start (point)))
|
|
259 (if alt
|
|
260 (insert "<IMG ALIGN=BOTTOM SRC=\"" href "\" ALT=\"" alt "\">")
|
|
261 (insert "<IMG ALIGN=BOTTOM SRC=\"" href "\">"))
|
|
262 (html-maybe-deemphasize-region (1+ start) (1- (point)))))
|
|
263
|
|
264
|
|
265 (defun hm--html-add-image-middle (href alt)
|
|
266 "Add an image, middle aligned."
|
|
267 (interactive (let ((url (hm--html-read-url "Image URL: ")))
|
|
268 (list url (hm--html-read-altenate url))))
|
|
269 (let ((start (point)))
|
|
270 (if alt
|
|
271 (insert "<IMG ALIGN=MIDDLE SRC=\"" href "\" ALT=\"" alt "\">")
|
|
272 (insert "<IMG ALIGN=MIDDLE SRC=\"" href "\">"))
|
|
273 (html-maybe-deemphasize-region (1+ start) (1- (point)))))
|
|
274
|
|
275
|
|
276 (defun hm--html-add-image-top (href alt)
|
|
277 "Add an image, top aligned."
|
|
278 (interactive (let ((url (hm--html-read-url "Image URL: ")))
|
|
279 (list url (hm--html-read-altenate url))))
|
|
280 (let ((start (point)))
|
|
281 (if alt
|
|
282 (insert "<IMG ALIGN=TOP SRC=\"" href "\" ALT=\"" alt "\">")
|
|
283 (insert "<IMG ALIGN=TOP SRC=\"" href "\">"))
|
|
284 (html-maybe-deemphasize-region (1+ start) (1- (point)))))
|
|
285
|
|
286
|
|
287 (defun hm--html-add-server-side-include-file (file)
|
|
288 "This function adds a server side include file directive in the buffer.
|
|
289 The directive is only supported by the NCSA http daemon."
|
|
290 (interactive "FInclude File: ")
|
|
291 (let ((start (point)))
|
|
292 (if (string= file "")
|
|
293 (error "ERROR: No filename specified !")
|
|
294 (insert "<INC SRV \"" file "\">")
|
|
295 (html-maybe-deemphasize-region (1+ start) (1- (point))))))
|
|
296
|
|
297
|
|
298 (defun hm--html-add-server-side-include-command-with-isindex-parameter
|
|
299 (command)
|
|
300 "This function adds a server side include command directive in the buffer.
|
|
301 The include command uses the \"isindex\"- parameter for the specified command."
|
|
302 (interactive (list
|
|
303 (completing-read "Include Command: "
|
|
304 hm--html-server-side-include-command-alist)))
|
|
305 (hm--html-add-server-side-include-command command t))
|
|
306
|
|
307
|
|
308 (defun hm--html-add-server-side-include-command (command &optional srvurl)
|
|
309 "This function adds a server side include command directive in the buffer.
|
|
310 The directive is only supported by the NCSA http daemon.
|
|
311 If SRVURL is t, then the attribute srvurl instead of srv is used for the
|
|
312 include command. With srvurl, the include command uses the \"isindex\"-
|
|
313 parameter for the specified command."
|
|
314 (interactive (list
|
|
315 (completing-read "Include Command: "
|
|
316 hm--html-server-side-include-command-alist)))
|
|
317 (let ((start (point))
|
|
318 (attribute (if srvurl "SRVURL" "SRV")))
|
|
319 (if (string= command "")
|
|
320 (error "ERROR: No command specified !")
|
|
321 (if (= ?| (string-to-char command))
|
|
322 (insert "<INC " attribute" \"" command "\">")
|
|
323 (insert "<INC " attribute " \"|" command "\">")
|
|
324 (html-maybe-deemphasize-region (1+ start) (1- (point)))))))
|
|
325
|
|
326
|
|
327 ;(defun hm--html-add-server-side-include-command-with-parameter (command
|
|
328 ; parameter)
|
|
329 ; "This function adds a server side include command directive in the buffer.
|
|
330 ;The directive is only supported by the NCSA http daemon."
|
|
331 ; (interactive (list
|
|
332 ; (completing-read
|
|
333 ; "Include Command: "
|
|
334 ; hm--html-server-side-include-command-with-parameter-alist)
|
|
335 ; (read-string "Parameterlist sepearted by '?': ")))
|
|
336 ; (let ((start (point)))
|
|
337 ; (if (string= command "")
|
|
338 ; (error "ERROR: No command specified !")
|
|
339 ; (if (string= parameter "")
|
|
340 ; (error "ERROR: No parameter specified !")
|
|
341 ; (if (= ?| (string-to-char command))
|
|
342 ; (if (= ?? (string-to-char parameter))
|
|
343 ; (insert "<INC SRVURL \"" command parameter "\">")
|
|
344 ; (insert "<INC SRVURL \"" command "?" parameter "\">"))
|
|
345 ; (if (= ?? (string-to-char parameter))
|
|
346 ; (insert "<INC SRVURL \"|" command parameter "\">")
|
|
347 ; (insert "<INC SRVURL \"|" command "?" parameter "\">")))
|
|
348 ; (html-maybe-deemphasize-region (1+ start) (1- (point)))))))
|
|
349
|
|
350
|
|
351
|
|
352 ;;; Functions, which adds tags of the form <starttag> ... </endtag>
|
|
353
|
|
354 (defun hm--html-add-bold ()
|
|
355 "Adds the HTML tags for Bold at the point in the current buffer."
|
|
356 (interactive)
|
|
357 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
358 "<B>"
|
|
359 'hm--html-insert-end-tag
|
|
360 "</B>"))
|
|
361
|
|
362
|
|
363 (defun hm--html-add-bold-to-region ()
|
|
364 "Adds the HTML tags for Bold to the region."
|
|
365 (interactive)
|
|
366 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
367 "<B>"
|
|
368 'hm--html-insert-end-tag
|
|
369 "</B>"))
|
|
370
|
|
371
|
|
372 (defun hm--html-add-italic ()
|
|
373 "Adds the HTML tags for Italic at the point in the current buffer."
|
|
374 (interactive)
|
|
375 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
376 "<I>"
|
|
377 'hm--html-insert-end-tag
|
|
378 "</I>"))
|
|
379
|
|
380
|
|
381 (defun hm--html-add-italic-to-region ()
|
|
382 "Adds the HTML tags for Italic to the region."
|
|
383 (interactive)
|
|
384 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
385 "<I>"
|
|
386 'hm--html-insert-end-tag
|
|
387 "</I>"))
|
|
388
|
|
389
|
|
390 (defun hm--html-add-underline ()
|
|
391 "Adds the HTML tags for Underline at the point in the current buffer."
|
|
392 (interactive)
|
|
393 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
394 "<U>"
|
|
395 'hm--html-insert-end-tag
|
|
396 "</U>"))
|
|
397
|
|
398
|
|
399 (defun hm--html-add-underline-to-region ()
|
|
400 "Adds the HTML tags for Underline to the region."
|
|
401 (interactive)
|
|
402 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
403 "<U>"
|
|
404 'hm--html-insert-end-tag
|
|
405 "</U>"))
|
|
406
|
|
407
|
|
408 (defun hm--html-add-definition ()
|
|
409 "Adds the HTML tags for Definition at the point in the current buffer."
|
|
410 (interactive)
|
|
411 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
412 "<DFN>"
|
|
413 'hm--html-insert-end-tag
|
|
414 "</DFN>"))
|
|
415
|
|
416
|
|
417 (defun hm--html-add-definition-to-region ()
|
|
418 "Adds the HTML tags for Definition to the region."
|
|
419 (interactive)
|
|
420 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
421 "<DFN>"
|
|
422 'hm--html-insert-end-tag
|
|
423 "</DFN>"))
|
|
424
|
|
425
|
|
426 (defun hm--html-add-code ()
|
|
427 "Adds the HTML tags for Code at the point in the current buffer."
|
|
428 (interactive)
|
|
429 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
430 "<CODE>"
|
|
431 'hm--html-insert-end-tag
|
|
432 "</CODE>"))
|
|
433
|
|
434
|
|
435 (defun hm--html-add-code-to-region ()
|
|
436 "Adds the HTML tags for Code to the region."
|
|
437 (interactive)
|
|
438 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
439 "<CODE>"
|
|
440 'hm--html-insert-end-tag
|
|
441 "</CODE>"))
|
|
442
|
|
443
|
|
444 (defun hm--html-add-citation-to-region ()
|
|
445 "Adds the HTML tags for Citation to the region."
|
|
446 (interactive)
|
|
447 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
448 "<CITE>"
|
|
449 'hm--html-insert-end-tag
|
|
450 "</CITE>"))
|
|
451
|
|
452
|
|
453 (defun hm--html-add-emphasized-to-region ()
|
|
454 "Adds the HTML tags for Emphasized to the region."
|
|
455 (interactive)
|
|
456 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
457 "<EM>"
|
|
458 'hm--html-insert-end-tag
|
|
459 "</EM>"))
|
|
460
|
|
461
|
|
462 (defun hm--html-add-fixed-to-region ()
|
|
463 "Adds the HTML tags for Fixed to the region."
|
|
464 (interactive)
|
|
465 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
466 "<TT>"
|
|
467 'hm--html-insert-end-tag
|
|
468 "</TT>"))
|
|
469
|
|
470
|
|
471 (defun hm--html-add-keyboard-to-region ()
|
|
472 "Adds the HTML tags for Keyboard to the region."
|
|
473 (interactive)
|
|
474 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
475 "<KBD>"
|
|
476 'hm--html-insert-end-tag
|
|
477 "</KBD>"))
|
|
478
|
|
479
|
|
480 (defun hm--html-add-sample-to-region ()
|
|
481 "Adds the HTML tags for Sample to the region."
|
|
482 (interactive)
|
|
483 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
484 "<SAMP>"
|
|
485 'hm--html-insert-end-tag
|
|
486 "</SAMP>"))
|
|
487
|
|
488
|
|
489 (defun hm--html-add-strong-to-region ()
|
|
490 "Adds the HTML tags for Strong to the region."
|
|
491 (interactive)
|
|
492 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
493 "<STRONG>"
|
|
494 'hm--html-insert-end-tag
|
|
495 "</STRONG>"))
|
|
496
|
|
497
|
|
498 (defun hm--html-add-variable-to-region ()
|
|
499 "Adds the HTML tags for Variable to the region."
|
|
500 (interactive)
|
|
501 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
502 "<VAR>"
|
|
503 'hm--html-insert-end-tag
|
|
504 "</VAR>"))
|
|
505
|
|
506
|
|
507 (defun hm--html-add-comment ()
|
|
508 "Adds the HTML tags for Comment at the point in the current buffer."
|
|
509 (interactive)
|
|
510 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
511 "<!-- "
|
|
512 'hm--html-insert-end-tag
|
|
513 " -->"))
|
|
514
|
|
515
|
|
516 (defun hm--html-add-comment-to-region ()
|
|
517 "Adds the HTML tags for Comment to the region."
|
|
518 (interactive)
|
|
519 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
520 "<!-- "
|
|
521 'hm--html-insert-end-tag
|
|
522 " -->"))
|
|
523
|
|
524
|
|
525
|
|
526 (defun hm--html-add-preformated ()
|
|
527 "Adds the HTML tags for preformated text at the point in the current buffer."
|
|
528 (interactive)
|
|
529 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
530 "<PRE>"
|
|
531 'hm--html-insert-end-tag-with-newline
|
|
532 "</PRE>"))
|
|
533
|
|
534
|
|
535 (defun hm--html-add-preformated-to-region ()
|
|
536 "Adds the HTML tags for preformated text to the region."
|
|
537 (interactive)
|
|
538 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
539 "<PRE>"
|
|
540 'hm--html-insert-end-tag-with-newline
|
|
541 "</PRE>"))
|
|
542
|
|
543
|
|
544 (defun hm--html-add-plaintext-to-region ()
|
|
545 "Adds the HTML tags for plaintext to the region."
|
|
546 (interactive)
|
|
547 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
548 "<XMP>"
|
|
549 'hm--html-insert-end-tag-with-newline
|
|
550 "</XMP>"))
|
|
551
|
|
552
|
|
553 (defun hm--html-add-blockquote-to-region ()
|
|
554 "Adds the HTML tags for blockquote to the region."
|
|
555 (interactive)
|
|
556 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
557 "<BLOCKQUOTE>"
|
|
558 'hm--html-insert-end-tag-with-newline
|
|
559 "</BLOCKQUOTE>"))
|
|
560
|
|
561 (defun hm--html-add-abstract ()
|
|
562 "Adds the HTML tags for abstract text at the point in the current buffer."
|
|
563 (interactive)
|
|
564 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
565 "<ABSTRACT>"
|
|
566 'hm--html-insert-end-tag-with-newline
|
|
567 "</ABSTRACT>"))
|
|
568
|
|
569
|
|
570 (defun hm--html-add-abstract-to-region ()
|
|
571 "Adds the HTML tags for abstract text to the region."
|
|
572 (interactive)
|
|
573 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
574 "<ABSTRACT>"
|
|
575 'hm--html-insert-end-tag-with-newline
|
|
576 "</ABSTRACT>"))
|
|
577
|
|
578
|
|
579
|
|
580 (defun hm--html-add-strikethru ()
|
|
581 "Adds the HTML tags for Strikethru at the point in the current buffer."
|
|
582 (interactive)
|
|
583 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
584 "<S>"
|
|
585 'hm--html-insert-end-tag
|
|
586 "</S>"))
|
|
587
|
|
588
|
|
589 (defun hm--html-add-strikethru-to-region ()
|
|
590 "Adds the HTML tags for Strikethru to the region."
|
|
591 (interactive)
|
|
592 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
593 "<S>"
|
|
594 'hm--html-insert-end-tag
|
|
595 "</S>"))
|
|
596
|
|
597
|
|
598 (defun hm--html-add-superscript ()
|
|
599 "Adds the HTML tags for Superscript at the point in the current buffer."
|
|
600 (interactive)
|
|
601 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
602 "<SUP>"
|
|
603 'hm--html-insert-end-tag
|
|
604 "</SUP>"))
|
|
605
|
|
606
|
|
607 (defun hm--html-add-superscript-to-region ()
|
|
608 "Adds the HTML tags for Superscript to the region."
|
|
609 (interactive)
|
|
610 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
611 "<SUP>"
|
|
612 'hm--html-insert-end-tag
|
|
613 "</SUP>"))
|
|
614
|
|
615
|
|
616 (defun hm--html-add-subscript ()
|
|
617 "Adds the HTML tags for Subscript at the point in the current buffer."
|
|
618 (interactive)
|
|
619 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
620 "<SUB>"
|
|
621 'hm--html-insert-end-tag
|
|
622 "</SUB>"))
|
|
623
|
|
624
|
|
625 (defun hm--html-add-subscript-to-region ()
|
|
626 "Adds the HTML tags for Subscript to the region."
|
|
627 (interactive)
|
|
628 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
629 "<SUB>"
|
|
630 'hm--html-insert-end-tag
|
|
631 "</SUB>"))
|
|
632
|
|
633
|
|
634 (defun hm--html-add-quote ()
|
|
635 "Adds the HTML tags for Quote at the point in the current buffer."
|
|
636 (interactive)
|
|
637 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
638 "<Q>"
|
|
639 'hm--html-insert-end-tag
|
|
640 "</Q>"))
|
|
641
|
|
642
|
|
643 (defun hm--html-add-quote-to-region ()
|
|
644 "Adds the HTML tags for Quote to the region."
|
|
645 (interactive)
|
|
646 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
647 "<Q>"
|
|
648 'hm--html-insert-end-tag
|
|
649 "</Q>"))
|
|
650
|
|
651
|
|
652 (defun hm--html-add-person ()
|
|
653 "Adds the HTML tags for Person at the point in the current buffer."
|
|
654 (interactive)
|
|
655 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
656 "<PERSON>"
|
|
657 'hm--html-insert-end-tag
|
|
658 "</PERSON>"))
|
|
659
|
|
660
|
|
661 (defun hm--html-add-person-to-region ()
|
|
662 "Adds the HTML tags for Person to the region."
|
|
663 (interactive)
|
|
664 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
665 "<PERSON>"
|
|
666 'hm--html-insert-end-tag
|
|
667 "</PERSON>"))
|
|
668
|
|
669
|
|
670 (defun hm--html-add-instance ()
|
|
671 "Adds the HTML tags for Instance at the point in the current buffer."
|
|
672 (interactive)
|
|
673 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
674 "<INS>"
|
|
675 'hm--html-insert-end-tag
|
|
676 "</INS>"))
|
|
677
|
|
678
|
|
679 (defun hm--html-add-instance-to-region ()
|
|
680 "Adds the HTML tags for Instance to the region."
|
|
681 (interactive)
|
|
682 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
683 "<INS>"
|
|
684 'hm--html-insert-end-tag
|
|
685 "</INS>"))
|
|
686
|
|
687
|
|
688 (defun hm--html-add-option ()
|
|
689 "Adds the HTML tags for Option at the point in the current buffer."
|
|
690 (interactive)
|
|
691 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
692 "<OPT>"
|
|
693 'hm--html-insert-end-tag
|
|
694 "</OPT>"))
|
|
695
|
|
696
|
|
697 (defun hm--html-add-option-to-region ()
|
|
698 "Adds the HTML tags for Option to the region."
|
|
699 (interactive)
|
|
700 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
701 "<OPT>"
|
|
702 'hm--html-insert-end-tag
|
|
703 "</OPT>"))
|
|
704
|
|
705
|
|
706 (defun hm--html-add-publication ()
|
|
707 "Adds the HTML tags for Publication at the point in the current buffer."
|
|
708 (interactive)
|
|
709 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
710 "<PUB>"
|
|
711 'hm--html-insert-end-tag
|
|
712 "</PUB>"))
|
|
713
|
|
714
|
|
715 (defun hm--html-add-publication-to-region ()
|
|
716 "Adds the HTML tags for Publication to the region."
|
|
717 (interactive)
|
|
718 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
719 "<PUB>"
|
|
720 'hm--html-insert-end-tag
|
|
721 "</PUB>"))
|
|
722
|
|
723
|
|
724 (defun hm--html-add-author ()
|
|
725 "Adds the HTML tags for Author at the point in the current buffer."
|
|
726 (interactive)
|
|
727 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
728 "<AUTHOR>"
|
|
729 'hm--html-insert-end-tag
|
|
730 "</AUTHOR>"))
|
|
731
|
|
732
|
|
733 (defun hm--html-add-author-to-region ()
|
|
734 "Adds the HTML tags for Author to the region."
|
|
735 (interactive)
|
|
736 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
737 "<AUTHOR>"
|
|
738 'hm--html-insert-end-tag
|
|
739 "</AUTHOR>"))
|
|
740
|
|
741
|
|
742 (defun hm--html-add-editor ()
|
|
743 "Adds the HTML tags for Editor at the point in the current buffer."
|
|
744 (interactive)
|
|
745 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
746 "<EDITOR>"
|
|
747 'hm--html-insert-end-tag
|
|
748 "</EDITOR>"))
|
|
749
|
|
750
|
|
751 (defun hm--html-add-editor-to-region ()
|
|
752 "Adds the HTML tags for Editor to the region."
|
|
753 (interactive)
|
|
754 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
755 "<EDITOR>"
|
|
756 'hm--html-insert-end-tag
|
|
757 "</EDITOR>"))
|
|
758
|
|
759
|
|
760 (defun hm--html-add-credits ()
|
|
761 "Adds the HTML tags for Credits at the point in the current buffer."
|
|
762 (interactive)
|
|
763 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
764 "<CREDITS>"
|
|
765 'hm--html-insert-end-tag
|
|
766 "</CREDITS>"))
|
|
767
|
|
768
|
|
769 (defun hm--html-add-credits-to-region ()
|
|
770 "Adds the HTML tags for Credits to the region."
|
|
771 (interactive)
|
|
772 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
773 "<CREDITS>"
|
|
774 'hm--html-insert-end-tag
|
|
775 "</CREDITS>"))
|
|
776
|
|
777
|
|
778 (defun hm--html-add-copyright ()
|
|
779 "Adds the HTML tags for Copyright at the point in the current buffer."
|
|
780 (interactive)
|
|
781 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
782 "<COPYRIGHT>"
|
|
783 'hm--html-insert-end-tag
|
|
784 "</COPYRIGHT>"))
|
|
785
|
|
786
|
|
787 (defun hm--html-add-copyright-to-region ()
|
|
788 "Adds the HTML tags for Copyright to the region."
|
|
789 (interactive)
|
|
790 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
791 "<COPYRIGHT>"
|
|
792 'hm--html-insert-end-tag
|
|
793 "</COPYRIGHT>"))
|
|
794
|
|
795
|
|
796 (defun hm--html-add-isbn ()
|
|
797 "Adds the HTML tags for ISBN at the point in the current buffer."
|
|
798 (interactive)
|
|
799 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
800 "<ISBN>"
|
|
801 'hm--html-insert-end-tag
|
|
802 "</ISBN>"))
|
|
803
|
|
804
|
|
805 (defun hm--html-add-isbn-to-region ()
|
|
806 "Adds the HTML tags for ISBN to the region."
|
|
807 (interactive)
|
|
808 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
809 "<ISBN>"
|
|
810 'hm--html-insert-end-tag
|
|
811 "</ISBN>"))
|
|
812
|
|
813
|
|
814 (defun hm--html-add-acronym ()
|
|
815 "Adds the HTML tags for Acronym at the point in the current buffer."
|
|
816 (interactive)
|
|
817 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
818 "<ACRONYM>"
|
|
819 'hm--html-insert-end-tag
|
|
820 "</ACRONYM>"))
|
|
821
|
|
822
|
|
823 (defun hm--html-add-acronym-to-region ()
|
|
824 "Adds the HTML tags for Acronym to the region."
|
|
825 (interactive)
|
|
826 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
827 "<ACRONYM>"
|
|
828 'hm--html-insert-end-tag
|
|
829 "</ACRONYM>"))
|
|
830
|
|
831
|
|
832 (defun hm--html-add-abbrevation ()
|
|
833 "Adds the HTML tags for Abbrevation at the point in the current buffer."
|
|
834 (interactive)
|
|
835 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
836 "<ABBREV>"
|
|
837 'hm--html-insert-end-tag
|
|
838 "</ABBREV>"))
|
|
839
|
|
840
|
|
841 (defun hm--html-add-abbrev-to-region ()
|
|
842 "Adds the HTML tags for Abbrev to the region."
|
|
843 (interactive)
|
|
844 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
845 "<ABBREV>"
|
|
846 'hm--html-insert-end-tag
|
|
847 "</ABBREV>"))
|
|
848
|
|
849
|
|
850 (defun hm--html-add-command ()
|
|
851 "Adds the HTML tags for Command at the point in the current buffer."
|
|
852 (interactive)
|
|
853 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
854 "<CMD>"
|
|
855 'hm--html-insert-end-tag
|
|
856 "</CMD>"))
|
|
857
|
|
858
|
|
859 (defun hm--html-add-command-to-region ()
|
|
860 "Adds the HTML tags for Command to the region."
|
|
861 (interactive)
|
|
862 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
863 "<CMD>"
|
|
864 'hm--html-insert-end-tag
|
|
865 "</CMD>"))
|
|
866
|
|
867
|
|
868 (defun hm--html-add-argument ()
|
|
869 "Adds the HTML tags for Argument at the point in the current buffer."
|
|
870 (interactive)
|
|
871 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
872 "<ARG>"
|
|
873 'hm--html-insert-end-tag
|
|
874 "</ARG>"))
|
|
875
|
|
876
|
|
877 (defun hm--html-add-argument-to-region ()
|
|
878 "Adds the HTML tags for Argument to the region."
|
|
879 (interactive)
|
|
880 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
881 "<ARG>"
|
|
882 'hm--html-insert-end-tag
|
|
883 "</ARG>"))
|
|
884
|
|
885
|
|
886 (defun hm--html-add-literature ()
|
|
887 "Adds the HTML tags for Literature at the point in the current buffer."
|
|
888 (interactive)
|
|
889 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
890 "<LIT>"
|
|
891 'hm--html-insert-end-tag
|
|
892 "</LIT>"))
|
|
893
|
|
894
|
|
895 (defun hm--html-add-literature-to-region ()
|
|
896 "Adds the HTML tags for Literature to the region."
|
|
897 (interactive)
|
|
898 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
899 "<LIT>"
|
|
900 'hm--html-insert-end-tag
|
|
901 "</LIT>"))
|
|
902
|
|
903
|
|
904 (defun hm--html-add-footnote ()
|
|
905 "Adds the HTML tags for Footnote at the point in the current buffer."
|
|
906 (interactive)
|
|
907 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
908 "<FOOTNOTE>"
|
|
909 'hm--html-insert-end-tag
|
|
910 "</FOOTNOTE>"))
|
|
911
|
|
912
|
|
913 (defun hm--html-add-footnote-to-region ()
|
|
914 "Adds the HTML tags for Footnote to the region."
|
|
915 (interactive)
|
|
916 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
917 "<FOOTNOTE>"
|
|
918 'hm--html-insert-end-tag
|
|
919 "</FOOTNOTE>"))
|
|
920
|
|
921
|
|
922 (defun hm--html-add-margin ()
|
|
923 "Adds the HTML tags for Margin at the point in the current buffer."
|
|
924 (interactive)
|
|
925 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
926 "<MARGIN>"
|
|
927 'hm--html-insert-end-tag
|
|
928 "</MARGIN>"))
|
|
929
|
|
930
|
|
931 (defun hm--html-add-margin-to-region ()
|
|
932 "Adds the HTML tags for Margin to the region."
|
|
933 (interactive)
|
|
934 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
935 "<MARGIN>"
|
|
936 'hm--html-insert-end-tag
|
|
937 "</MARGIN>"))
|
|
938
|
|
939
|
|
940
|
|
941
|
|
942
|
|
943 ;;; Lists
|
|
944
|
|
945
|
|
946 (defun hm--html-add-listing-to-region ()
|
|
947 "Adds the HTML tags for listing to the region."
|
|
948 (interactive)
|
|
949 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
950 "<LISTING>"
|
|
951 'hm--html-insert-end-tag-with-newline
|
|
952 "</LISTING>"))
|
|
953
|
|
954
|
|
955 (defun hm--html-add-numberlist ()
|
|
956 "Adds the HTML tags for a numbered list at the point in the current buffer."
|
|
957 (interactive)
|
|
958 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
959 "<OL>"
|
|
960 'hm--html-insert-end-tag-with-newline
|
|
961 "</OL>"
|
|
962 'hm--html-insert-start-tag
|
|
963 "<LI> "))
|
|
964
|
|
965 (defun hm--html-add-numberlist-to-region ()
|
|
966 "Adds the HTML tags for a numbered list to the region."
|
|
967 (interactive)
|
|
968 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
969 "<OL>"
|
|
970 'hm--html-insert-end-tag-with-newline
|
|
971 "</OL>"
|
|
972 'hm--html-insert-start-tag
|
|
973 "<LI> "))
|
|
974
|
|
975
|
|
976 (defun hm--html-add-directory-list ()
|
|
977 "Adds the HTML tags for a directory list at the point in the current buffer."
|
|
978 (interactive)
|
|
979 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
980 "<DIR>"
|
|
981 'hm--html-insert-end-tag-with-newline
|
|
982 "</DIR>"
|
|
983 'hm--html-insert-start-tag
|
|
984 "<LI> "))
|
|
985
|
|
986 (defun hm--html-add-directorylist-to-region ()
|
|
987 "Adds the HTML tags for a directory list to the region."
|
|
988 (interactive)
|
|
989 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
990 "<DIR>"
|
|
991 'hm--html-insert-end-tag-with-newline
|
|
992 "</DIR>"
|
|
993 'hm--html-insert-start-tag
|
|
994 "<LI> "))
|
|
995
|
|
996
|
|
997 (defun hm--html-add-list-to-region ()
|
|
998 "Adds the HTML tags for a (unnumbered) list to the region."
|
|
999 (interactive)
|
|
1000 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
1001 "<UL>"
|
|
1002 'hm--html-insert-end-tag-with-newline
|
|
1003 "</UL>"
|
|
1004 'hm--html-insert-start-tag
|
|
1005 "<LI> "))
|
|
1006
|
|
1007
|
|
1008 (defun hm--html-add-menu-to-region ()
|
|
1009 "Adds the HTML tags for a menu to the region."
|
|
1010 (interactive)
|
|
1011 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
1012 "<MENU>"
|
|
1013 'hm--html-insert-end-tag-with-newline
|
|
1014 "</MENU>"
|
|
1015 'hm--html-insert-start-tag
|
|
1016 "<LI> "))
|
|
1017
|
|
1018
|
|
1019 (defun hm--html-add-description-list-to-region ()
|
|
1020 "Adds the HTML tags for a description list to a region.
|
|
1021 It also inserts a tag for the description title."
|
|
1022 (interactive)
|
|
1023 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
1024 "<DL>"
|
|
1025 'hm--html-insert-end-tag-with-newline
|
|
1026 "</DL>"
|
|
1027 'hm--html-insert-start-tag
|
|
1028 "<DT> "))
|
|
1029
|
|
1030
|
|
1031 (defun hm--html-add-description-title ()
|
|
1032 "Adds the HTML tag for a description title at current point in the buffer."
|
|
1033 (interactive)
|
|
1034 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline
|
|
1035 "<DT> "))
|
|
1036
|
|
1037
|
|
1038 (defun hm--html-add-only-description-entry ()
|
|
1039 "Adds the HTML tag for a description entry at current point in the buffer."
|
|
1040 (interactive)
|
|
1041 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline
|
|
1042 "<DD> "))
|
|
1043
|
|
1044
|
|
1045 (defun hm--html-add-address-to-region ()
|
|
1046 "Adds the HTML tags for an address to the region"
|
|
1047 (interactive)
|
|
1048 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
1049 "<ADDRESS> "
|
|
1050 'hm--html-insert-end-tag
|
|
1051 " </ADDRESS>"))
|
|
1052
|
|
1053
|
|
1054 (defvar hm--html-signature-reference-name "Signature"
|
|
1055 "The signature reference name.")
|
|
1056
|
|
1057
|
|
1058 (defun hm--html-make-signature-link-string (signature-file-name)
|
|
1059 "Returns a string which is a link to a signature file."
|
|
1060 (concat
|
|
1061 "<A Name="
|
|
1062 hm--html-signature-reference-name
|
|
1063 " HREF=\""
|
|
1064 signature-file-name
|
|
1065 "\">"))
|
|
1066
|
|
1067
|
|
1068 (defun hm--html-delete-old-signature ()
|
|
1069 "Searches for the old signature and deletes it, if the user want it"
|
|
1070 (save-excursion
|
|
1071 (goto-char (point-min))
|
|
1072 (if (search-forward (concat "<address> "
|
|
1073 "<a name="
|
|
1074 hm--html-signature-reference-name
|
|
1075 " href=\"")
|
|
1076 nil
|
|
1077 t)
|
|
1078 (let ((signature-start (match-beginning 0))
|
|
1079 (signature-end (progn
|
|
1080 (search-forward "</address>" nil t)
|
|
1081 (point))))
|
|
1082 (if (yes-or-no-p "Delete the old signature (yes or no) ?")
|
|
1083 (delete-region signature-start signature-end))))))
|
|
1084
|
|
1085
|
|
1086 (defun hm--html-set-point-for-signature ()
|
|
1087 "Searches and sets the point for inserting the signature.
|
|
1088 It searches from the end to the beginning of the file. At first it
|
|
1089 tries to use the point before the </body> tag then the point before
|
|
1090 the </html> tag and the the end of the file."
|
|
1091 (goto-char (point-max))
|
|
1092 (cond ((search-backward "</body>" nil t)
|
|
1093 (end-of-line 0)
|
|
1094 (if (> (current-column) 0)
|
|
1095 (newline 2)))
|
|
1096 ((search-backward "</html>" nil t)
|
|
1097 (end-of-line 0)
|
|
1098 (if (> (current-column) 0)
|
|
1099 (newline 2)))
|
|
1100 ((> (current-column) 0)
|
|
1101 (newline 2))
|
|
1102 (t)))
|
|
1103
|
|
1104
|
|
1105 (defun hm--html-add-signature ()
|
|
1106 "Adds the owner's signature at the end of the buffer."
|
|
1107 (interactive)
|
|
1108 (if hm--html-signature-file
|
|
1109 (progn
|
|
1110 (if (not hm--html-username)
|
|
1111 (setq hm--html-username (user-full-name)))
|
|
1112 (save-excursion
|
|
1113 (hm--html-delete-old-signature)
|
|
1114 (hm--html-set-point-for-signature)
|
|
1115 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
1116 "<ADDRESS> "
|
|
1117 'hm--html-insert-end-tag
|
|
1118 "</A></ADDRESS>"
|
|
1119 'hm--html-insert-start-tag
|
|
1120 (hm--html-make-signature-link-string
|
|
1121 hm--html-signature-file)
|
|
1122 )
|
|
1123 (insert hm--html-username)))
|
|
1124 (error "ERROR: Define your hm--html-signature-file first !")))
|
|
1125
|
|
1126
|
|
1127 (defun hm--html-add-header (size &optional header)
|
|
1128 "Adds the HTML tags for a header at the point in the current buffer."
|
|
1129 (interactive "nSize (1 .. 6; 1 biggest): ")
|
|
1130 (if (or (< size 1) (> size 6))
|
|
1131 (message "The size must be a number from 1 to 6 !")
|
|
1132 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
1133 (format "<H%d>" size)
|
|
1134 'hm--html-insert-start-tag-with-newline
|
|
1135 (format "</H%d>" size))
|
|
1136 (if header
|
|
1137 (insert header))))
|
|
1138
|
|
1139
|
|
1140 (defun hm--html-add-header-to-region (size)
|
|
1141 "Adds the HTML tags for a header to the region.
|
|
1142 The parameter 'size' specifies the size of the header."
|
|
1143 (interactive "nSize (1 .. 6; 1 biggest): ")
|
|
1144 (if (or (< size 1) (> size 6))
|
|
1145 (message "The size must be a number from 1 to 6 !")
|
|
1146 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
1147 (format "<H%d>" size)
|
|
1148 'hm--html-insert-end-tag
|
|
1149 (format "</H%d>" size))))
|
|
1150
|
|
1151
|
|
1152 (defun hm--html-set-point-for-title ()
|
|
1153 "Searches and sets the point for inserting the HTML element title.
|
|
1154 The functions start at the beginning of the file and searches first
|
|
1155 for the HTML tag <ISINDEX>. If such a tag exists, the point is set to the
|
|
1156 position after the tag. If not, the function next searches for the
|
|
1157 tag <HEAD> and sets the point after the tag, if it exists, or searches for
|
|
1158 the tag <HTML>. If this tag exists, the point is set to the position after
|
|
1159 this tag or the beginning of the file otherwise."
|
|
1160 (goto-char (point-min))
|
|
1161 (cond ((search-forward-regexp "<isindex>" nil t) (newline))
|
|
1162 ((search-forward-regexp "<head>" nil t) (newline))
|
|
1163 ((search-forward-regexp "<html>" nil t) (newline))
|
|
1164 (t)))
|
|
1165
|
|
1166
|
|
1167 (defun hm--html-add-title (title)
|
|
1168 "Adds the HTML tags for a title at the beginning of the buffer."
|
|
1169 (interactive "sTitle: ")
|
|
1170 (save-excursion
|
|
1171 (goto-char (point-min))
|
|
1172 (if (search-forward "<title>" nil t)
|
|
1173 (let ((point-after-start-tag (point)))
|
|
1174 (if (not (search-forward "</title>" nil t))
|
|
1175 nil
|
|
1176 (goto-char (- (point) 8))
|
|
1177 (delete-backward-char (- (point) point-after-start-tag))
|
|
1178 (let ((start (point)))
|
|
1179 (insert title " (" (hm--date) ")")
|
|
1180 (goto-char start))))
|
|
1181 ;; Noch kein <TITLE> im Buffer vorhanden
|
|
1182 (hm--html-set-point-for-title)
|
|
1183 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
1184 "<TITLE>"
|
|
1185 'hm--html-insert-end-tag
|
|
1186 "</TITLE>"
|
|
1187 'insert
|
|
1188 (concat title " (" (hm--date) ")"))
|
|
1189 (forward-char 8)
|
|
1190 (newline 1)
|
|
1191 )))
|
|
1192
|
|
1193
|
|
1194 (defun hm--html-add-title-to-region ()
|
|
1195 "Adds the HTML tags for a title to the region."
|
|
1196 (interactive)
|
|
1197 (let ((title (buffer-substring (region-beginning) (region-end))))
|
|
1198 (save-excursion
|
|
1199 (goto-char (point-min))
|
|
1200 (if (search-forward "<title>" nil t)
|
|
1201 (let ((point-after-start-tag (point)))
|
|
1202 (if (not (search-forward "</title>" nil t))
|
|
1203 nil
|
|
1204 (goto-char (- (point) 8))
|
|
1205 (delete-backward-char (- (point) point-after-start-tag))
|
|
1206 (insert title " (" (hm--date) ")")))
|
|
1207 ;; Noch kein <TITLE> im Buffer vorhanden
|
|
1208 (hm--html-set-point-for-title)
|
|
1209 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
1210 "<TITLE>"
|
|
1211 'hm--html-insert-end-tag
|
|
1212 "</TITLE>"
|
|
1213 'insert
|
|
1214 (concat title " (" (hm--date) ")"))
|
|
1215 (forward-char 8)
|
|
1216 ;(newline 1)
|
|
1217 ))))
|
|
1218
|
|
1219
|
|
1220 (defun hm--html-add-html ()
|
|
1221 "Adds the HTML tags <HTML> and </HTML> in the buffer.
|
|
1222 The tag <HTML> will be inserted at the beginning and </HTML> at the
|
|
1223 end of the file."
|
|
1224 (interactive)
|
|
1225 (let ((new-cursor-position nil))
|
|
1226 (save-excursion
|
|
1227 (goto-char (point-min))
|
|
1228 (if (search-forward "<html>" nil t)
|
|
1229 (error "There is an old tag <HTML> in the current buffer !")
|
|
1230 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline "<HTML>")
|
|
1231 ; (newline 1)
|
|
1232 )
|
|
1233 (setq new-cursor-position (point))
|
|
1234 (goto-char (point-max))
|
|
1235 (if (search-backward "</html>" nil t)
|
|
1236 (error "There is an old tag </HTML> in the current buffer !")
|
|
1237 (newline 1)
|
|
1238 (hm--html-add-tags 'hm--html-insert-end-tag "</HTML>")))
|
|
1239 (goto-char new-cursor-position)))
|
|
1240
|
|
1241
|
|
1242 (defun hm--html-add-head ()
|
|
1243 "Adds the HTML tags <HEAD> and </HEAD> in the buffer.
|
|
1244 The tags will be inserted after <HTML> or at the beginning of the file.
|
|
1245 The function also looks for the tags <BODY> and </TITLE>."
|
|
1246 (interactive)
|
|
1247 (goto-char (point-min))
|
|
1248 (if (search-forward "<html>" nil t)
|
|
1249 (if (search-forward "<head>" nil t)
|
|
1250 (error "There is an old tag <HEAD> in the current buffer !")
|
|
1251 (if (search-forward "</head>" nil t)
|
|
1252 (error "There is an old tag </HEAD> in the current buffer !")
|
|
1253 (newline 1))))
|
|
1254 (let ((start-tag-position (point)))
|
|
1255 (if (search-forward "<body>" nil t)
|
|
1256 (progn
|
|
1257 (forward-line 0)
|
|
1258 (forward-char -1)
|
|
1259 (if (= (point) (point-min))
|
|
1260 (progn
|
|
1261 (newline)
|
|
1262 (forward-line -1)))
|
|
1263 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline
|
|
1264 "</HEAD>")
|
|
1265 (goto-char start-tag-position)
|
|
1266 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
1267 "<HEAD>")
|
|
1268 )
|
|
1269 (if (search-forward "</title>" nil t)
|
|
1270 (progn
|
|
1271 (newline 1)
|
|
1272 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline
|
|
1273 "</HEAD>")
|
|
1274 (goto-char start-tag-position)
|
|
1275 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
1276 "<HEAD>"))
|
|
1277 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
1278 "<HEAD>"
|
|
1279 'hm--html-insert-end-tag-with-newline
|
|
1280 "</HEAD>")))))
|
|
1281
|
|
1282
|
|
1283 (defun hm--html-add-head-to-region ()
|
|
1284 "Adds the HTML tags <HEAD> and </HEAD> to the region."
|
|
1285 (interactive)
|
|
1286 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
1287 "<HEAD>"
|
|
1288 'hm--html-insert-end-tag-with-newline
|
|
1289 "</HEAD>"))
|
|
1290
|
|
1291
|
|
1292 (defun hm--html-add-body ()
|
|
1293 "Adds the HTML tags <BODY> and </BODY> in the buffer.
|
|
1294 The tags will be inserted before </HTML> or at the end of the file."
|
|
1295 (interactive)
|
|
1296 (goto-char (point-max))
|
|
1297 (if (search-backward "</html>" nil t)
|
|
1298 (progn
|
|
1299 (if (search-backward "</body>" nil t)
|
|
1300 (error "There is an old tag </BODY> in the current buffer !")
|
|
1301 (if (search-backward "<body>" nil t)
|
|
1302 (error "There is an old tag <BODY> in the current buffer !")))
|
|
1303 (forward-char -1)))
|
|
1304 (let ((end-tag-position (point)))
|
|
1305 (if (search-backward "</head>" nil t)
|
|
1306 (progn
|
|
1307 (forward-char 7)
|
|
1308 (newline 1)
|
|
1309 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
1310 "<BODY>")
|
|
1311 (let ((cursor-position (point)))
|
|
1312 (goto-char (+ end-tag-position 8))
|
|
1313 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline
|
|
1314 "</BODY>")
|
|
1315 (goto-char cursor-position)
|
|
1316 ))
|
|
1317 (if (not (= (current-column) 0))
|
|
1318 (newline))
|
|
1319 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline "<BODY>"
|
|
1320 'hm--html-insert-end-tag-with-newline "</BODY>"))))
|
|
1321
|
|
1322
|
|
1323 (defun hm--html-add-body-to-region ()
|
|
1324 "Adds the HTML tags <BODY> and </BODY> to the region."
|
|
1325 (interactive)
|
|
1326 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
1327 "<BODY>"
|
|
1328 'hm--html-insert-end-tag-with-newline
|
|
1329 "</BODY>"))
|
|
1330
|
|
1331
|
|
1332 (defun hm--html-add-title-and-header (title)
|
|
1333 "Adds the HTML tags for a title and a header in the current buffer."
|
|
1334 ; (interactive "sTitle and Header String: \nnHeader Size (1 .. 6): ")
|
|
1335 ; (if (> size 6)
|
|
1336 ; (message "The size must be a number from 1 to 6 !")
|
|
1337 (interactive "sTitle and Header String: ")
|
|
1338 (hm--html-add-title title)
|
|
1339 (save-excursion
|
|
1340 (goto-char (point-min))
|
|
1341 (search-forward "</title>" nil t)
|
|
1342 (if (search-forward "</head>" nil t)
|
|
1343 (progn
|
|
1344 (search-forward "<body>" nil t)
|
|
1345 (newline 1))
|
|
1346 (if (search-forward "<body>" nil t)
|
|
1347 (newline 1)
|
|
1348 (if (string= (what-line) "Line 1")
|
|
1349 (progn
|
|
1350 (end-of-line)
|
|
1351 (newline 1)))))
|
|
1352 (hm--html-add-header 1 title)))
|
|
1353
|
|
1354
|
|
1355 (defun hm--html-add-title-and-header-to-region ()
|
|
1356 "Adds the HTML tags for a title and a header to the region."
|
|
1357 ;The parameter 'size' spezifies the size of the header.";"
|
|
1358 ; (interactive "nSize (1 .. 6): ")
|
|
1359 ; (if (> size 6)
|
|
1360 ; (message "The size must be a number from 1 to 6 !")
|
|
1361 (interactive)
|
|
1362 (let ((title (buffer-substring (region-beginning) (region-end))))
|
|
1363 (hm--html-add-header-to-region 1)
|
|
1364 (hm--html-add-title title)))
|
|
1365
|
|
1366
|
|
1367 (defun hm--html-add-full-html-frame (title)
|
|
1368 "Adds a full HTML frame to the current buffer.
|
|
1369 The frame consists of the elements html, head, body, title,
|
|
1370 header and the signature. The parameter TITLE specifies the
|
|
1371 title and the header of the document."
|
|
1372 (interactive "sTitle and Header String: ")
|
|
1373 (hm--html-add-html)
|
|
1374 (hm--html-add-head)
|
|
1375 (hm--html-add-body)
|
|
1376 (hm--html-add-title-and-header title)
|
|
1377 (if hm--html-signature-file
|
|
1378 (hm--html-add-signature))
|
|
1379 (goto-char (point-min))
|
|
1380 (search-forward "</h1>" nil t)
|
|
1381 (forward-line 1)
|
|
1382 (if hm--html-automatic-created-comment
|
|
1383 (hm--html-insert-created-comment)))
|
|
1384
|
|
1385
|
|
1386 (defun hm--html-add-full-html-frame-with-region ()
|
|
1387 "Adds a full HTML frame to the current buffer with the use of a region.
|
|
1388 The frame consists of the elements html, head, body, title,
|
|
1389 header and the signature. The function uses the region as
|
|
1390 the string for the title and the header of the document."
|
|
1391 (interactive)
|
|
1392 (hm--html-add-title-and-header-to-region)
|
|
1393 (hm--html-add-html)
|
|
1394 (hm--html-add-head)
|
|
1395 (hm--html-add-body)
|
|
1396 (hm--html-add-signature)
|
|
1397 (if hm--html-automatic-created-comment
|
|
1398 (hm--html-insert-created-comment)))
|
|
1399
|
|
1400
|
|
1401 (defun hm--html-add-link-target (name)
|
|
1402 "Adds the HTML tags for a link target at point in the current buffer."
|
|
1403 ; (interactive "sName (or RET for numeric): ")
|
|
1404 (interactive "sName: ")
|
|
1405 ; (and (string= name "")
|
|
1406 ; (progn
|
|
1407 ; (setq html-link-counter (1+ html-link-counter))
|
|
1408 ; (setq name (format "%d" html-link-counter))))
|
|
1409 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
1410 (concat "<A NAME=\"" name "\">")
|
|
1411 'hm--html-insert-end-tag
|
|
1412 "</A>"))
|
|
1413
|
|
1414
|
|
1415 ;;; Functions which add links
|
|
1416
|
|
1417 (defun hm--html-mark-example (parameter-list)
|
|
1418 "Marks the example of the parameterlist in the current buffer.
|
|
1419 It returns the example extent."
|
|
1420 (if (hm--html-get-example-from-parameter-list parameter-list)
|
|
1421 (progn
|
|
1422 (search-forward (hm--html-get-example-from-parameter-list
|
|
1423 parameter-list))
|
|
1424 (let ((extent (make-extent (match-beginning 0)
|
|
1425 (match-end 0))))
|
|
1426 (set-extent-face extent 'hm--html-help-face)
|
|
1427 extent))))
|
|
1428
|
|
1429
|
|
1430 (defun hm--html-unmark-example (extent)
|
|
1431 "Unmarks the example for the current question."
|
|
1432 (if extent
|
|
1433 (delete-extent extent)))
|
|
1434
|
|
1435 ; )
|
|
1436 ; ;; For the Emacs 19
|
|
1437 ; (defun hm--html-mark-example (parameter-list)
|
|
1438 ; "Marks the example of the parameterlist in the current buffer.
|
|
1439 ;It returns the example extent."
|
|
1440 ; (if (hm--html-get-example-from-parameter-list parameter-list)
|
|
1441 ; (progn
|
|
1442 ; (search-forward (hm--html-get-example-from-parameter-list
|
|
1443 ; parameter-list))
|
|
1444 ; (put-text-property (match-beginning 0)
|
|
1445 ; (match-end 0)
|
|
1446 ; 'face
|
|
1447 ; 'hm--html-help-face))))
|
|
1448 ;
|
|
1449 ;
|
|
1450 ; (defun hm--html-unmark-example (extent)
|
|
1451 ; "Unmarks the example for the current question."
|
|
1452 ; t))
|
|
1453
|
|
1454
|
|
1455 (defun hm--html-write-alist-in-buffer (alist)
|
|
1456 "The function writes the contents of the ALIST in the currentbuffer."
|
|
1457 (cond ((car alist)
|
|
1458 (insert (int-to-string (car (car alist))) ":\t" (cdr (car alist)))
|
|
1459 (newline)
|
|
1460 (hm--html-write-alist-in-buffer (cdr alist)))))
|
|
1461
|
|
1462
|
|
1463 (defun hm--html-select-directory (alist default)
|
|
1464 "The function selects one of the directories of the ALIST,
|
|
1465 or the DEFAULT or the 'default-directory' by number. See also the
|
|
1466 documentation of the function hm--html-read-filename."
|
|
1467 (if (or (string= default "") (not default))
|
|
1468 (setq default default-directory))
|
|
1469 (if alist
|
|
1470 (save-window-excursion
|
|
1471 (let ((buffername (generate-new-buffer "*html-directories*")))
|
|
1472 (set-buffer buffername)
|
|
1473 (insert "Select one of the following directories by number !")
|
|
1474 (newline)
|
|
1475 (insert "===================================================")
|
|
1476 (newline)
|
|
1477 (insert "0:\t" default)
|
|
1478 (newline)
|
|
1479 (hm--html-write-alist-in-buffer alist)
|
|
1480 (goto-char (point-min))
|
|
1481 (pop-to-buffer buffername))
|
|
1482 (let ((dirnumber (read-number
|
|
1483 "Select directory prefix by number: "
|
|
1484 t)))
|
|
1485 (kill-buffer "*html-directories*")
|
|
1486 (expand-file-name (or (cdr (assoc dirnumber alist)) default))))
|
|
1487 (expand-file-name default))
|
|
1488 )
|
|
1489
|
|
1490
|
|
1491 (defun hm--html-delete-wrong-path-prefix-1 (filename prefix-list)
|
|
1492 "The function deletes wrong path prefixes."
|
|
1493 (cond (prefix-list (if (string-match (car prefix-list) filename)
|
|
1494 (substring filename (match-end 0))
|
|
1495 (hm--html-delete-wrong-path-prefix-1 filename
|
|
1496 (cdr prefix-list)
|
|
1497 )))
|
|
1498 (t filename)))
|
|
1499
|
|
1500
|
|
1501 (defun hm--html-delete-wrong-path-prefix (filename)
|
|
1502 "The function deletes wrong path prefixes.
|
|
1503 The path prefixes are specified by the variable
|
|
1504 `hm--html-delete-wrong-path-prefix'."
|
|
1505 (if (not hm--html-delete-wrong-path-prefix)
|
|
1506 filename
|
|
1507 (if (listp hm--html-delete-wrong-path-prefix)
|
|
1508 (hm--html-delete-wrong-path-prefix-1 filename
|
|
1509 hm--html-delete-wrong-path-prefix)
|
|
1510 (hm--html-delete-wrong-path-prefix-1 filename
|
|
1511 (list
|
|
1512 hm--html-delete-wrong-path-prefix))
|
|
1513 )))
|
|
1514
|
|
1515
|
|
1516 (defun hm--html-read-filename (parameter-list)
|
|
1517 "The function reads a filename with its directory path,
|
|
1518 if PARAMETER-LIST is not nil. If the PARAMETER-LIST is nil, only an empty
|
|
1519 string will be returned.
|
|
1520 The PARAMETER-LIST consists of the following elements:
|
|
1521 PROMPT, ALIST, DEFAULT, REQUIRE-MATCH, EXAMPLE.
|
|
1522 If the ALIST is nil and DEFAULT is nil, then the function only reads
|
|
1523 a filename (without path). These precede the following.
|
|
1524 If the ALIST isn't nil, the function lists the contents of the ALIST
|
|
1525 in a buffer and reads a number from the minbuffer, which selects one
|
|
1526 of the directories (lines) of the buffer. Therefore the ALIST must look
|
|
1527 like the following alist:
|
|
1528 ((1 . \"/appl/gnu/\") (2 . \"/\"))
|
|
1529 If only ALIST is nil, or if you type a number which is not in the ALIST,
|
|
1530 the DEFAULT directory is selected. If the DEFAULT is nil or \"\" the
|
|
1531 'default-directory' is selected.
|
|
1532 After that the function reads the name of the file from the minibuffer.
|
|
1533 Therefore the PROMPT is printed in the minibuffer and the selected directory
|
|
1534 is taken as the start of the path of the file.
|
|
1535 If REQUIRE-MATCH is t, the filename with path must match an existing file."
|
|
1536 (if parameter-list
|
|
1537 (let ((marked-object (hm--html-mark-example parameter-list))
|
|
1538 (prompt (hm--html-get-prompt-from-parameter-list parameter-list))
|
|
1539 (alist (hm--html-get-alist-from-parameter-list parameter-list))
|
|
1540 (default (hm--html-get-default-from-parameter-list parameter-list))
|
|
1541 (require-match (hm--html-get-require-match-from-parameter-list
|
|
1542 parameter-list))
|
|
1543 (filename nil))
|
|
1544 (if (or alist default)
|
|
1545 (let ((directory (hm--html-select-directory alist default)))
|
|
1546 (setq filename (read-file-name prompt
|
|
1547 directory
|
|
1548 directory
|
|
1549 require-match
|
|
1550 nil)))
|
|
1551 (setq filename (read-file-name prompt
|
|
1552 ""
|
|
1553 ""
|
|
1554 require-match
|
|
1555 nil)))
|
|
1556 (hm--html-unmark-example marked-object)
|
|
1557 (hm--html-delete-wrong-path-prefix filename))
|
|
1558 ; (if (not hm--html-delete-wrong-path-prefix)
|
|
1559 ; filename
|
|
1560 ; (if (string-match hm--html-delete-wrong-path-prefix filename)
|
|
1561 ; (substring filename (match-end 0))
|
|
1562 ; filename)))
|
|
1563 ""))
|
|
1564
|
|
1565
|
|
1566 (defun hm--html-completing-read (parameter-list)
|
|
1567 "Reads a string with completing-read, if alist is non nil.
|
|
1568 The PARAMETER-LIST consists of the following elements:
|
|
1569 PROMPT, ALIST, DEFAULT, REQUIRE-MATCH, EXAMPLE.
|
|
1570 If ALIST is nil, it returns the DEFAULT, or if the DEFAULT is
|
|
1571 also nil it returns an empty string."
|
|
1572 (let ((marked-object (hm--html-mark-example parameter-list))
|
|
1573 (string
|
|
1574 (if (hm--html-get-alist-from-parameter-list parameter-list)
|
|
1575 (completing-read
|
|
1576 (hm--html-get-prompt-from-parameter-list parameter-list)
|
|
1577 (hm--html-get-alist-from-parameter-list parameter-list)
|
|
1578 nil
|
|
1579 (hm--html-get-require-match-from-parameter-list
|
|
1580 parameter-list)
|
|
1581 (hm--html-get-default-from-parameter-list
|
|
1582 parameter-list))
|
|
1583 (if (hm--html-get-default-from-parameter-list parameter-list)
|
|
1584 (hm--html-get-default-from-parameter-list parameter-list)
|
|
1585 ""))))
|
|
1586 (hm--html-unmark-example marked-object)
|
|
1587 string))
|
|
1588
|
|
1589
|
|
1590 (defvar hm--html-faces-exist nil)
|
|
1591
|
|
1592
|
|
1593 (defun hm--html-generate-help-buffer-faces ()
|
|
1594 "Generates faces for the add-link-help-buffer."
|
|
1595 (if (not (facep 'hm--html-help-face))
|
|
1596 ; (if (not hm--html-faces-exist)
|
|
1597 (progn
|
|
1598 (setq hm--html-faces-exist t)
|
|
1599 (make-face 'hm--html-help-face)
|
|
1600 (and hm--html-help-foreground
|
|
1601 (set-face-foreground 'hm--html-help-face
|
|
1602 hm--html-help-foreground))
|
|
1603 (and hm--html-help-background
|
|
1604 (set-face-background 'hm--html-help-face
|
|
1605 hm--html-help-background))
|
|
1606 (and hm--html-help-font
|
|
1607 (set-face-font 'hm--html-help-face hm--html-help-font))
|
|
1608 )))
|
|
1609
|
|
1610
|
|
1611 (defun hm--html-get-prompt-from-parameter-list (parameter-list)
|
|
1612 "Returns the prompt from the PARAMETER-LIST."
|
|
1613 (car parameter-list))
|
|
1614
|
|
1615
|
|
1616 (defun hm--html-get-alist-from-parameter-list (parameter-list)
|
|
1617 "Returns the alist from the PARAMETER-LIST."
|
|
1618 (car (cdr parameter-list)))
|
|
1619
|
|
1620
|
|
1621 (defun hm--html-get-default-from-parameter-list (parameter-list)
|
|
1622 "Returns the default from the PARAMETER-LIST."
|
|
1623 (car (cdr (cdr parameter-list))))
|
|
1624
|
|
1625
|
|
1626 (defun hm--html-get-require-match-from-parameter-list (parameter-list)
|
|
1627 "Returns the require-match from the PARAMETER-LIST."
|
|
1628 (car (cdr (cdr (cdr parameter-list)))))
|
|
1629
|
|
1630
|
|
1631 (defun hm--html-get-example-from-parameter-list (parameter-list)
|
|
1632 "Returns the example from the PARAMETER-LIST."
|
|
1633 (car (cdr (cdr (cdr (cdr parameter-list))))))
|
|
1634
|
|
1635
|
|
1636 (defun hm--html-get-anchor-seperator-from-parameter-list (parameter-list)
|
|
1637 "Returns the anchor-seperator from the PARAMETER-LIST."
|
|
1638 (car (cdr (cdr (cdr (cdr (cdr parameter-list)))))))
|
|
1639
|
|
1640
|
|
1641 (defun hm--html-generate-add-link-help-buffer (scheme-parameter-list
|
|
1642 host-name:port-parameter-list
|
|
1643 servername:port-parameter-list
|
|
1644 path+file-parameter-list
|
|
1645 anchor-parameter-list)
|
|
1646 "Generates and displays a help buffer with an example for adding a link."
|
|
1647 (let ((buffername (generate-new-buffer "*Link-Example*")))
|
|
1648 (pop-to-buffer buffername)
|
|
1649 (shrink-window (- (window-height) 5))
|
|
1650 (insert "Example:")
|
|
1651 (newline 2)
|
|
1652 (if (hm--html-get-example-from-parameter-list scheme-parameter-list)
|
|
1653 (progn
|
|
1654 (insert (hm--html-get-example-from-parameter-list
|
|
1655 scheme-parameter-list))
|
|
1656 (if (hm--html-get-example-from-parameter-list
|
|
1657 scheme-parameter-list)
|
|
1658 (progn
|
|
1659 (insert ":")
|
|
1660 (if (hm--html-get-example-from-parameter-list
|
|
1661 host-name:port-parameter-list)
|
|
1662 (insert "//"))))))
|
|
1663 (if (hm--html-get-example-from-parameter-list
|
|
1664 host-name:port-parameter-list)
|
|
1665 (progn
|
|
1666 (insert (hm--html-get-example-from-parameter-list
|
|
1667 host-name:port-parameter-list))
|
|
1668 (if (and (hm--html-get-example-from-parameter-list
|
|
1669 servername:port-parameter-list)
|
|
1670 (not (string= "/"
|
|
1671 (substring
|
|
1672 (hm--html-get-example-from-parameter-list
|
|
1673 servername:port-parameter-list)
|
|
1674 0
|
|
1675 1))))
|
|
1676 (insert "/"))))
|
|
1677 (if (hm--html-get-example-from-parameter-list
|
|
1678 servername:port-parameter-list)
|
|
1679 (progn
|
|
1680 (insert (hm--html-get-example-from-parameter-list
|
|
1681 servername:port-parameter-list))
|
|
1682 (if (hm--html-get-example-from-parameter-list
|
|
1683 path+file-parameter-list)
|
|
1684 (insert "/"))))
|
|
1685 (if (hm--html-get-example-from-parameter-list path+file-parameter-list)
|
|
1686 (progn
|
|
1687 (insert (hm--html-get-example-from-parameter-list
|
|
1688 path+file-parameter-list))))
|
|
1689 (if (hm--html-get-example-from-parameter-list anchor-parameter-list)
|
|
1690 (progn
|
|
1691 (insert (hm--html-get-anchor-seperator-from-parameter-list
|
|
1692 anchor-parameter-list))
|
|
1693 (insert (hm--html-get-example-from-parameter-list
|
|
1694 anchor-parameter-list))))
|
|
1695 (goto-char (point-min))
|
|
1696 buffername
|
|
1697 ))
|
|
1698
|
|
1699
|
|
1700 (defun hm--html-add-link (function-add-tags
|
|
1701 scheme-parameter-list
|
|
1702 host-name:port-parameter-list
|
|
1703 servername:port-parameter-list
|
|
1704 path+file-parameter-list
|
|
1705 anchor-parameter-list)
|
|
1706 "The function adds a link in the current buffer.
|
|
1707 The parameter FUNCTION-ADD-TAGS determines the function which adds the tag
|
|
1708 in the buffer (for example: 'hm--html-add-tags or
|
|
1709 'hm--html-add-tags-to-region).
|
|
1710 The parameters SCHEME-PARAMETER-LIST, HOST-NAME:PORT-PARAMETER-LIST,
|
|
1711 SERVERNAME:PORT-PARAMETER-LIST, PATH+FILE-PARAMETER-LIST and
|
|
1712 ANCHOR-PARAMETER-LIST are lists with a prompt string, an alist, a default
|
|
1713 value and an example string. The ANCHOR-PARAMETER-LIST has as an additional
|
|
1714 element an anchor seperator string. All these elements are used to read and
|
|
1715 construct the link."
|
|
1716 (let ((point nil))
|
|
1717 (save-window-excursion
|
|
1718 (let ((html-buffer (current-buffer))
|
|
1719 (html-help-buffer (hm--html-generate-add-link-help-buffer
|
|
1720 scheme-parameter-list
|
|
1721 host-name:port-parameter-list
|
|
1722 servername:port-parameter-list
|
|
1723 path+file-parameter-list
|
|
1724 anchor-parameter-list))
|
|
1725 (scheme (hm--html-completing-read scheme-parameter-list))
|
|
1726 (hostname:port (hm--html-completing-read
|
|
1727 host-name:port-parameter-list))
|
|
1728 (servername:port (hm--html-completing-read
|
|
1729 servername:port-parameter-list))
|
|
1730 (path+file (hm--html-read-filename path+file-parameter-list))
|
|
1731 (anchor (hm--html-completing-read anchor-parameter-list))
|
|
1732 ; (hrefname (setq html-link-counter (1+ html-link-counter)))
|
|
1733 (anchor-seperator
|
|
1734 (hm--html-get-anchor-seperator-from-parameter-list
|
|
1735 anchor-parameter-list)))
|
|
1736 (if (not (string= scheme ""))
|
|
1737 (if (string= hostname:port "")
|
|
1738 (setq scheme (concat scheme ":"))
|
|
1739 (setq scheme (concat scheme "://"))))
|
|
1740 (if (and (not (string= hostname:port ""))
|
|
1741 (not (string= servername:port ""))
|
|
1742 (not (string= (substring servername:port 0 1) "/")))
|
|
1743 (setq servername:port (concat "/" servername:port)))
|
|
1744 (if (and (not (string= path+file ""))
|
|
1745 (not (string= "/" (substring path+file 0 1))))
|
|
1746 (setq path+file (concat "/" path+file)))
|
|
1747 (if (not (string= anchor ""))
|
|
1748 (setq anchor (concat anchor-seperator anchor)))
|
|
1749 (kill-buffer html-help-buffer)
|
|
1750 (pop-to-buffer html-buffer)
|
|
1751 (eval (list function-add-tags
|
|
1752 ''hm--html-insert-start-tag
|
|
1753 (concat "<A"
|
|
1754 ; "<A Name="
|
|
1755 ; hrefname
|
|
1756 " HREF=\""
|
|
1757 scheme
|
|
1758 hostname:port
|
|
1759 servername:port
|
|
1760 path+file
|
|
1761 anchor
|
|
1762 "\">")
|
|
1763 ''hm--html-insert-end-tag
|
|
1764 "</A>")))
|
|
1765 (setq point (point))))
|
|
1766 (goto-char (point)))
|
|
1767
|
|
1768
|
|
1769 (defun hm--html-add-info-link-1 (function-add-tags)
|
|
1770 "Internal function. Adds the HTML tags for a link on a GNU Info file."
|
|
1771 (hm--html-add-link function-add-tags
|
|
1772 (list ; scheme
|
|
1773 ""
|
|
1774 nil
|
|
1775 "http"
|
|
1776 t
|
|
1777 "http")
|
|
1778 (list ; hostname:port
|
|
1779 "Gateway and Port: "
|
|
1780 hm--html-info-hostname:port-alist
|
|
1781 hm--html-info-hostname:port-default
|
|
1782 nil
|
|
1783 "www.tnt.uni-hannover.de:8005")
|
|
1784 (list ; servername:port
|
|
1785 ""
|
|
1786 nil
|
|
1787 ""
|
|
1788 t
|
|
1789 nil)
|
|
1790 (list ; path/file
|
|
1791 "Path/File: "
|
|
1792 hm--html-info-path-alist
|
|
1793 nil
|
|
1794 nil
|
|
1795 "/appl/lemacs/Global/info/dir")
|
|
1796 (list ; anchor
|
|
1797 "Node: "
|
|
1798 '((""))
|
|
1799 nil
|
|
1800 nil
|
|
1801 "emacs"
|
|
1802 ",")))
|
|
1803
|
|
1804
|
|
1805 (defun hm--html-add-info-link ()
|
|
1806 "Adds the HTML tags for a link on a GNU Info file."
|
|
1807 (interactive)
|
|
1808 (hm--html-add-info-link-1 'hm--html-add-tags))
|
|
1809
|
|
1810
|
|
1811 (defun hm--html-add-info-link-to-region ()
|
|
1812 "Adds the HTML tags for a link on a GNU Info file to the region."
|
|
1813 (interactive)
|
|
1814 (hm--html-add-info-link-1 'hm--html-add-tags-to-region))
|
|
1815
|
|
1816
|
|
1817 (defun hm--html-add-wais-link-1 (function-add-tags)
|
|
1818 "Internal function. Adds the HTML tags for a link to a WAIS server."
|
|
1819 (hm--html-add-link function-add-tags
|
|
1820 (list ; scheme
|
|
1821 ""
|
|
1822 nil
|
|
1823 "http"
|
|
1824 t
|
|
1825 "http")
|
|
1826 (list ; hostname:port
|
|
1827 "Gateway and Port: "
|
|
1828 hm--html-wais-hostname:port-alist
|
|
1829 hm--html-wais-hostname:port-default
|
|
1830 nil
|
|
1831 "www.tnt.uni-hannover.de:8001")
|
|
1832 (list ; servername:port
|
|
1833 "Wais Servername and Port: "
|
|
1834 hm--html-wais-servername:port-alist
|
|
1835 hm--html-wais-servername:port-default
|
|
1836 nil
|
|
1837 "quake.think.com:210")
|
|
1838 (list ; path/file
|
|
1839 "Database: "
|
|
1840 hm--html-wais-path-alist
|
|
1841 nil
|
|
1842 nil
|
|
1843 "database")
|
|
1844 (list ; anchor
|
|
1845 "Searchstring: "
|
|
1846 '((""))
|
|
1847 nil
|
|
1848 nil
|
|
1849 "searchstring"
|
|
1850 "?")))
|
|
1851
|
|
1852
|
|
1853 (defun hm--html-add-wais-link ()
|
|
1854 "Adds the HTML tags for a link to a WAIS server."
|
|
1855 (interactive)
|
|
1856 (hm--html-add-wais-link-1 'hm--html-add-tags))
|
|
1857
|
|
1858
|
|
1859 (defun hm--html-add-wais-link-to-region ()
|
|
1860 "Adds the HTML tags for a link to a WAIS server to the region."
|
|
1861 (interactive)
|
|
1862 (hm--html-add-wais-link-1 'hm--html-add-tags-to-region))
|
|
1863
|
|
1864
|
|
1865 (defun hm--html-add-direct-wais-link-1 (function-add-tags)
|
|
1866 "Internal function. Adds the HTML tags for a direct link to a WAIS server.
|
|
1867 This function uses the new direct WAIS support instead of a WAIS gateway."
|
|
1868 (hm--html-add-link function-add-tags
|
|
1869 (list ; scheme
|
|
1870 ""
|
|
1871 nil
|
|
1872 "wais"
|
|
1873 t
|
|
1874 "wais")
|
|
1875 (list ; hostname:port
|
|
1876 "Wais Servername and Port: "
|
|
1877 hm--html-wais-servername:port-alist
|
|
1878 hm--html-wais-servername:port-default
|
|
1879 nil
|
|
1880 "quake.think.com:210")
|
|
1881 (list ; servername:port
|
|
1882 ""
|
|
1883 nil
|
|
1884 ""
|
|
1885 t
|
|
1886 nil)
|
|
1887 (list ; path/file
|
|
1888 "Database: "
|
|
1889 hm--html-wais-path-alist
|
|
1890 nil
|
|
1891 nil
|
|
1892 "database")
|
|
1893 (list ; anchor
|
|
1894 "Searchstring: "
|
|
1895 '((""))
|
|
1896 nil
|
|
1897 nil
|
|
1898 "searchstring"
|
|
1899 "?")))
|
|
1900
|
|
1901
|
|
1902 (defun hm--html-add-direct-wais-link ()
|
|
1903 "Adds the HTML tags for a direct link to a WAIS server.
|
|
1904 This function uses the new direct WAIS support instead of a WAIS gateway."
|
|
1905 (interactive)
|
|
1906 (hm--html-add-direct-wais-link-1 'hm--html-add-tags))
|
|
1907
|
|
1908
|
|
1909 (defun hm--html-add-direct-wais-link-to-region ()
|
|
1910 "Adds the HTML tags for a direct link to a WAIS server to the region.
|
|
1911 This function uses the new direct WAIS support instead of a WAIS gateway."
|
|
1912 (interactive)
|
|
1913 (hm--html-add-direct-wais-link-1 'hm--html-add-tags-to-region))
|
|
1914
|
|
1915
|
|
1916 (defun hm--html-add-html-link-1 (function-add-tags)
|
|
1917 "Internal function. Adds the HTML tags for a link to an HTML page."
|
|
1918 (hm--html-add-link function-add-tags
|
|
1919 (list ; scheme
|
|
1920 ""
|
|
1921 nil
|
|
1922 "http"
|
|
1923 t
|
|
1924 "http")
|
|
1925 (list ; hostname:port
|
|
1926 "Servername and Port: "
|
|
1927 hm--html-html-hostname:port-alist
|
|
1928 hm--html-html-hostname:port-default
|
|
1929 nil
|
|
1930 "www.tnt.uni-hannover.de:80")
|
|
1931 (list ; servername:port
|
|
1932 ""
|
|
1933 nil
|
|
1934 ""
|
|
1935 t
|
|
1936 nil)
|
|
1937 (list ; path/file
|
|
1938 "Path/File: "
|
|
1939 hm--html-html-path-alist
|
|
1940 nil
|
|
1941 nil
|
|
1942 "/data/info/www/tnt/overview.html")
|
|
1943 (list ; anchor
|
|
1944 "Anchor: "
|
|
1945 '((""))
|
|
1946 nil
|
|
1947 nil
|
|
1948 "1"
|
|
1949 "#")))
|
|
1950
|
|
1951
|
|
1952 (defun hm--html-add-html-link ()
|
|
1953 "Adds the HTML tags for a link to an HTML file."
|
|
1954 (interactive)
|
|
1955 (hm--html-add-html-link-1 'hm--html-add-tags))
|
|
1956
|
|
1957
|
|
1958 (defun hm--html-add-html-link-to-region ()
|
|
1959 "Adds the HTML tags for a link to an HTML file to the region."
|
|
1960 (interactive)
|
|
1961 (hm--html-add-html-link-1 'hm--html-add-tags-to-region))
|
|
1962
|
|
1963
|
|
1964 (defun hm--html-add-file-link-1 (function-add-tags)
|
|
1965 "Internal function. Adds the HTML tags for a filegateway link."
|
|
1966 (hm--html-add-link function-add-tags
|
|
1967 (list ; scheme
|
|
1968 ""
|
|
1969 nil
|
|
1970 "file"
|
|
1971 t
|
|
1972 "file")
|
|
1973 (list ; hostname:port
|
|
1974 ""
|
|
1975 nil
|
|
1976 ""
|
|
1977 t
|
|
1978 nil)
|
|
1979 (list ; servername:port
|
|
1980 ""
|
|
1981 nil
|
|
1982 ""
|
|
1983 t
|
|
1984 nil)
|
|
1985 (list ; path/file
|
|
1986 "Path/File: "
|
|
1987 hm--html-file-path-alist
|
|
1988 nil
|
|
1989 nil
|
|
1990 "/data/info/www/tnt/overview.html")
|
|
1991 (list ; anchor
|
|
1992 "Anchor: "
|
|
1993 '((""))
|
|
1994 nil
|
|
1995 nil
|
|
1996 "1"
|
|
1997 "#")))
|
|
1998
|
|
1999
|
|
2000 (defun hm--html-add-file-link ()
|
|
2001 "Adds the HTML tags for a for a filegateway link."
|
|
2002 (interactive)
|
|
2003 (hm--html-add-file-link-1 'hm--html-add-tags))
|
|
2004
|
|
2005
|
|
2006 (defun hm--html-add-file-link-to-region ()
|
|
2007 "Adds the HTML tags for a for a filegateway link to the region."
|
|
2008 (interactive)
|
|
2009 (hm--html-add-file-link-1 'hm--html-add-tags-to-region))
|
|
2010
|
|
2011
|
|
2012 (defun hm--html-add-ftp-link-1 (function-add-tags)
|
|
2013 "Internal function. Adds the HTML tags for a link to an FTP server."
|
|
2014 (hm--html-add-link function-add-tags
|
|
2015 (list ; scheme
|
|
2016 ""
|
|
2017 nil
|
|
2018 "ftp"
|
|
2019 t
|
|
2020 "ftp")
|
|
2021 (list ; hostname:port
|
|
2022 "FTP Servername: "
|
|
2023 hm--html-ftp-hostname:port-alist
|
|
2024 hm--html-ftp-hostname:port-default
|
|
2025 nil
|
|
2026 "ftp.rrzn.uni-hannover.de")
|
|
2027 (list ; servername:port
|
|
2028 ""
|
|
2029 nil
|
|
2030 ""
|
|
2031 t
|
|
2032 nil)
|
|
2033 (list ; path/file
|
|
2034 "Path/File: "
|
|
2035 hm--html-ftp-path-alist
|
|
2036 nil
|
|
2037 nil
|
|
2038 "/pub/gnu/gcc-2.4.5.tar.gz")
|
|
2039 (list ; anchor
|
|
2040 ""
|
|
2041 nil
|
|
2042 ""
|
|
2043 t
|
|
2044 nil
|
|
2045 nil)))
|
|
2046
|
|
2047
|
|
2048 (defun hm--html-add-ftp-link ()
|
|
2049 "Adds the HTML tags for a link to an FTP server."
|
|
2050 (interactive)
|
|
2051 (hm--html-add-ftp-link-1 'hm--html-add-tags))
|
|
2052
|
|
2053
|
|
2054 (defun hm--html-add-ftp-link-to-region ()
|
|
2055 "Adds the HTML tags for a link to an FTP server to the region."
|
|
2056 (interactive)
|
|
2057 (hm--html-add-ftp-link-1 'hm--html-add-tags-to-region))
|
|
2058
|
|
2059
|
|
2060 (defun hm--html-add-gopher-link-1 (function-add-tags)
|
|
2061 "Internal function. Adds the HTML tags for a link to a gopher server."
|
|
2062 (hm--html-add-link function-add-tags
|
|
2063 (list ; scheme
|
|
2064 ""
|
|
2065 nil
|
|
2066 "gopher"
|
|
2067 t
|
|
2068 "gopher")
|
|
2069 (list ; hostname:port
|
|
2070 "Gopher Servername: "
|
|
2071 hm--html-gopher-hostname:port-alist
|
|
2072 hm--html-gopher-hostname:port-default
|
|
2073 nil
|
|
2074 "newsserver.rrzn.uni-hannover.de:70")
|
|
2075 (list ; servername:port
|
|
2076 "Documenttype: "
|
|
2077 hm--html-gopher-doctype-alist
|
|
2078 hm--html-gopher-doctype-default
|
|
2079 nil
|
|
2080 "/1")
|
|
2081 nil ; path/file
|
|
2082 (list ; anchor
|
|
2083 "Entrypoint: "
|
|
2084 hm--html-gopher-anchor-alist
|
|
2085 nil
|
|
2086 nil
|
|
2087 "Subject%20Tree"
|
|
2088 "/")))
|
|
2089
|
|
2090
|
|
2091 (defun hm--html-add-gopher-link ()
|
|
2092 "Adds the HTML tags for a link to a gopher server."
|
|
2093 (interactive)
|
|
2094 (hm--html-add-gopher-link-1 'hm--html-add-tags))
|
|
2095
|
|
2096
|
|
2097 (defun hm--html-add-gopher-link-to-region ()
|
|
2098 "Adds the HTML tags for a link to a gopher server to the region."
|
|
2099 (interactive)
|
|
2100 (hm--html-add-gopher-link-1 'hm--html-add-tags-to-region))
|
|
2101
|
|
2102
|
|
2103 (defun hm--html-make-proggate-alist (proggate-allowed-file)
|
|
2104 "Makes a proggate-alist from the PROGGATE-ALLOWED-FILE."
|
|
2105 (if (and (stringp proggate-allowed-file)
|
|
2106 (file-exists-p proggate-allowed-file))
|
|
2107 (save-window-excursion
|
|
2108 (let ((alist nil)
|
|
2109 (buffername (find-file-noselect proggate-allowed-file)))
|
|
2110 (set-buffer buffername)
|
|
2111 (toggle-read-only)
|
|
2112 (goto-char (point-min))
|
|
2113 (while (search-forward-regexp "[^ \t\n]+" nil t)
|
|
2114 (setq alist (append (list (list (buffer-substring
|
|
2115 (match-beginning 0)
|
|
2116 (match-end 0))))
|
|
2117 alist)))
|
|
2118 (kill-buffer buffername)
|
|
2119 alist))
|
|
2120 (error "ERROR: Can't find the 'hm--html-progate-allowed-file !")))
|
|
2121
|
|
2122
|
|
2123 (defun hm--html-add-proggate-link-1 (function-add-tags)
|
|
2124 "Internal function. Adds the HTML tags for a link to a program.
|
|
2125 The program is called via the program gateway.
|
|
2126 Email to muenkel@tnt.uni-hannover.de for information over
|
|
2127 this gateway."
|
|
2128 (let ((progname-alist (hm--html-make-proggate-alist
|
|
2129 hm--html-proggate-allowed-file)))
|
|
2130 (hm--html-add-link function-add-tags
|
|
2131 (list ; scheme
|
|
2132 ""
|
|
2133 nil
|
|
2134 "http"
|
|
2135 t
|
|
2136 "http")
|
|
2137 (list ; hostname:port
|
|
2138 "Servername and Port: "
|
|
2139 hm--html-proggate-hostname:port-alist
|
|
2140 hm--html-proggate-hostname:port-default
|
|
2141 nil
|
|
2142 "www.tnt.uni-hannover.de:8007")
|
|
2143 (list ; program
|
|
2144 "Programname: "
|
|
2145 progname-alist
|
|
2146 nil
|
|
2147 nil
|
|
2148 "/usr/ucb/man")
|
|
2149 nil ; path/file
|
|
2150 (list ; Program Parameter
|
|
2151 "Programparameter: "
|
|
2152 '((""))
|
|
2153 nil
|
|
2154 nil
|
|
2155 "8+lpd"
|
|
2156 "+"))))
|
|
2157
|
|
2158
|
|
2159 (defun hm--html-add-proggate-link ()
|
|
2160 "Adds the HTML tags for a link to a program.
|
|
2161 The program is called via the program gateway.
|
|
2162 Email to muenkel@tnt.uni-hannover.de for information over
|
|
2163 this gateway."
|
|
2164 (interactive)
|
|
2165 (hm--html-add-proggate-link-1 'hm--html-add-tags))
|
|
2166
|
|
2167
|
|
2168 (defun hm--html-add-proggate-link-to-region ()
|
|
2169 "Adds the HTML tags for a link to a program to the region.
|
|
2170 The program is called via the program gateway.
|
|
2171 Email to muenkel@tnt.uni-hannover.de for information over
|
|
2172 this gateway."
|
|
2173 (interactive)
|
|
2174 (hm--html-add-proggate-link-1 'hm--html-add-tags-to-region))
|
|
2175
|
|
2176
|
|
2177 (defun hm--html-add-local-proggate-link-1 (function-add-tags)
|
|
2178 "Internal function. Adds the HTML tags for a link to a program.
|
|
2179 The program is called via the local program gateway.
|
|
2180 Email to muenkel@tnt.uni-hannover.de for information over
|
|
2181 this gateway."
|
|
2182 (hm--html-add-link function-add-tags
|
|
2183 (list ; scheme
|
|
2184 ""
|
|
2185 nil
|
|
2186 ""
|
|
2187 t
|
|
2188 nil)
|
|
2189 (list ; hostname:port
|
|
2190 ""
|
|
2191 nil
|
|
2192 ""
|
|
2193 t
|
|
2194 nil)
|
|
2195 (list ; servername:port
|
|
2196 ""
|
|
2197 nil
|
|
2198 ""
|
|
2199 t
|
|
2200 nil)
|
|
2201 (list ; path/file
|
|
2202 "Path/file: "
|
|
2203 hm--html-local-proggate-path-alist
|
|
2204 nil
|
|
2205 nil
|
|
2206 "/data/info/programs/lemacs.evlm")
|
|
2207 (list ; anchor
|
|
2208 ""
|
|
2209 nil
|
|
2210 ""
|
|
2211 t
|
|
2212 nil)))
|
|
2213
|
|
2214
|
|
2215 (defun hm--html-add-local-proggate-link ()
|
|
2216 "Adds the HTML tags for a link to a program.
|
|
2217 The program is called via the local program gateway.
|
|
2218 Email to muenkel@tnt.uni-hannover.de for information over
|
|
2219 this gateway."
|
|
2220 (interactive)
|
|
2221 (hm--html-add-local-proggate-link-1 'hm--html-add-tags))
|
|
2222
|
|
2223
|
|
2224 (defun hm--html-add-local-proggate-link-to-region ()
|
|
2225 "Adds the HTML tags for a link to a program to the region.
|
|
2226 The program is called via the local program gateway.
|
|
2227 Email to muenkel@tnt.uni-hannover.de for information over
|
|
2228 this gateway."
|
|
2229 (interactive)
|
|
2230 (hm--html-add-local-proggate-link-1 'hm--html-add-tags-to-region))
|
|
2231
|
|
2232
|
|
2233 (defvar hm--html-newsgroup-alist nil
|
|
2234 "Alist with newsgroups for the newsgateway.")
|
|
2235
|
|
2236
|
|
2237 (defvar gnus-newsrc-assoc nil)
|
|
2238
|
|
2239
|
|
2240 (defun hm--html-make-newsgroup-alist ()
|
|
2241 "Makes a hm--html-make-newsgroup-alist from a .newsrc.el file.
|
|
2242 The function looks at the environment variable NNTPSERVER.
|
|
2243 If this variable exists, it trys to open the file with the Name
|
|
2244 ~/$NNTPSERVER.el. If this file exists, the alist of the file is
|
|
2245 returned as the newsgroup-alist. If the file doesn't exist, it
|
|
2246 tries to use the file ~/$NNTPSERVER to make the alist. The function
|
|
2247 returns '((\"\"))"
|
|
2248 (if hm--html-newsgroup-alist
|
|
2249 hm--html-newsgroup-alist
|
|
2250 (if gnus-newsrc-assoc
|
|
2251 (setq hm--html-newsgroup-alist gnus-newsrc-assoc)
|
|
2252 (if (not (getenv "NNTPSERVER"))
|
|
2253 '((""))
|
|
2254 (let ((newsrc-file (expand-file-name (concat "~/.newsrc-"
|
|
2255 (getenv "NNTPSERVER")))))
|
|
2256 (if (file-exists-p (concat newsrc-file ".el"))
|
|
2257 (progn
|
|
2258 (load-file (concat newsrc-file ".el"))
|
|
2259 (setq hm--html-newsgroup-alist gnus-newsrc-assoc))
|
|
2260 (if (not (file-exists-p newsrc-file))
|
|
2261 '((""))
|
|
2262 (save-window-excursion
|
|
2263 (let ((alist nil)
|
|
2264 (buffername (find-file-noselect newsrc-file)))
|
|
2265 (set-buffer buffername)
|
|
2266 (toggle-read-only)
|
|
2267 (goto-char (point-min))
|
|
2268 (while (search-forward-regexp "[^:!]+" nil t)
|
|
2269 (setq alist (append (list (list (buffer-substring
|
|
2270 (match-beginning 0)
|
|
2271 (match-end 0))))
|
|
2272 alist))
|
|
2273 (search-forward-regexp "\n"))
|
|
2274 (kill-buffer buffername)
|
|
2275 (setq hm--html-newsgroup-alist alist))))))))))
|
|
2276
|
|
2277
|
|
2278
|
|
2279 (defun hm--html-add-news-link-1 (function-add-tags)
|
|
2280 "Internal function. Adds the HTML tags for a link to a news group."
|
|
2281 (let ((newsgroup-alist (hm--html-make-newsgroup-alist)))
|
|
2282 (hm--html-add-link function-add-tags
|
|
2283 (list ; scheme
|
|
2284 ""
|
|
2285 nil
|
|
2286 "news"
|
|
2287 t
|
|
2288 "news")
|
|
2289 (list ; hostname:port
|
|
2290 ""
|
|
2291 nil
|
|
2292 ""
|
|
2293 t
|
|
2294 nil)
|
|
2295 (list ; servername:port
|
|
2296 "NEWS Group: "
|
|
2297 newsgroup-alist
|
|
2298 nil
|
|
2299 nil
|
|
2300 "comp.emacs.xemacs")
|
|
2301 nil ; path/file
|
|
2302 (list ; anchor
|
|
2303 ""
|
|
2304 nil
|
|
2305 ""
|
|
2306 t
|
|
2307 nil
|
|
2308 nil))))
|
|
2309
|
|
2310
|
|
2311 (defun hm--html-add-news-link ()
|
|
2312 "Adds the HTML tags for a link to a news group."
|
|
2313 (interactive)
|
|
2314 (hm--html-add-news-link-1 'hm--html-add-tags))
|
|
2315
|
|
2316
|
|
2317 (defun hm--html-add-news-link-to-region ()
|
|
2318 "Adds the HTML tags for a link to a news group to the region."
|
|
2319 (interactive)
|
|
2320 (hm--html-add-news-link-1 'hm--html-add-tags-to-region))
|
|
2321
|
|
2322
|
|
2323 (defun hm--html-add-mail-box-link-1 (function-add-tags)
|
|
2324 "Internal function. Adds the HTML tags for a link to a mail box."
|
|
2325 (hm--html-add-link function-add-tags
|
|
2326 (list ; scheme
|
|
2327 ""
|
|
2328 nil
|
|
2329 "http"
|
|
2330 t
|
|
2331 "http")
|
|
2332 (list ; hostname:port
|
|
2333 "Hostname and Port: "
|
|
2334 hm--html-mail-hostname:port-alist
|
|
2335 hm--html-mail-hostname:port-default
|
|
2336 nil
|
|
2337 "www.tnt.uni-hannover.de:8003")
|
|
2338 (list ; servername:port
|
|
2339 ""
|
|
2340 nil
|
|
2341 ""
|
|
2342 t
|
|
2343 nil)
|
|
2344 (list ; path/file
|
|
2345 "Path/File: "
|
|
2346 hm--html-mail-path-alist
|
|
2347 nil
|
|
2348 nil
|
|
2349 "/data/info/mail/mailbox")
|
|
2350 (list ; anchor
|
|
2351 ""
|
|
2352 nil
|
|
2353 ""
|
|
2354 t
|
|
2355 nil
|
|
2356 nil)))
|
|
2357
|
|
2358
|
|
2359 (defun hm--html-add-mail-box-link ()
|
|
2360 "Adds the HTML tags for a link to a mail box."
|
|
2361 (interactive)
|
|
2362 (hm--html-add-mail-link-1 'hm--html-add-tags))
|
|
2363
|
|
2364
|
|
2365 (defun hm--html-add-mail-box-link-to-region ()
|
|
2366 "Adds the HTML tags for a link to a mail box to the region."
|
|
2367 (interactive)
|
|
2368 (hm--html-add-mail-link-1 'hm--html-add-tags-to-region))
|
|
2369
|
|
2370
|
|
2371 (defun hm--html-add-mailto-link-1 (function-add-tags)
|
|
2372 "Internal function. Adds the HTML tags for a mailto link."
|
|
2373 (let ((mailto-alist (if (and (boundp 'user-mail-address)
|
|
2374 user-mail-address)
|
|
2375 (cons (list user-mail-address)
|
|
2376 hm--html-mailto-alist)
|
|
2377 hm--html-mailto-alist)))
|
|
2378 (hm--html-add-link function-add-tags
|
|
2379 (list ; scheme
|
|
2380 ""
|
|
2381 nil
|
|
2382 "mailto"
|
|
2383 t
|
|
2384 "mailto")
|
|
2385 (list ; hostname:port
|
|
2386 ""
|
|
2387 nil
|
|
2388 ""
|
|
2389 t
|
|
2390 nil)
|
|
2391 (list ; servername:port
|
|
2392 "Mailadresse: "
|
|
2393 mailto-alist
|
|
2394 nil
|
|
2395 nil
|
|
2396 "muenkel@tnt.uni-hannover.de")
|
|
2397 nil ; path/file
|
|
2398 (list ; anchor
|
|
2399 ""
|
|
2400 nil
|
|
2401 ""
|
|
2402 t
|
|
2403 nil
|
|
2404 nil))))
|
|
2405
|
|
2406 (defun hm--html-add-mailto-link ()
|
|
2407 "Adds the HTML tags for a mailto link."
|
|
2408 (interactive)
|
|
2409 (hm--html-add-mailto-link-1 'hm--html-add-tags))
|
|
2410
|
|
2411
|
|
2412 (defun hm--html-add-mailto-link-to-region ()
|
|
2413 "Adds the HTML tags for a mailto link to the region."
|
|
2414 (interactive)
|
|
2415 (hm--html-add-mailto-link-1 'hm--html-add-tags-to-region))
|
|
2416
|
|
2417
|
|
2418 (defun hm--html-add-normal-link-to-region ()
|
|
2419 "Adds the HTML tags for a normal general link to region."
|
|
2420 (interactive)
|
|
2421 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
2422 (concat "<A HREF=\""
|
|
2423 (read-string "Link to: ")
|
|
2424 "\">")
|
|
2425 'hm--html-insert-end-tag
|
|
2426 "</A>"))
|
|
2427
|
|
2428
|
|
2429 (defun hm--html-add-normal-node-link ()
|
|
2430 "Adds the HTML tags for a normal node link (<LINK...>) at the point."
|
|
2431 (interactive)
|
|
2432 (hm--html-insert-start-tag (concat "<LINK HREF=\""
|
|
2433 (read-string "Node Link to: ")
|
|
2434 "\">")
|
|
2435 ))
|
|
2436
|
|
2437 ;;; Functions to update the date and the changelog entries
|
|
2438
|
|
2439
|
|
2440 (defun hm--html-maybe-new-date-and-changed-comment ()
|
|
2441 "Hook function which updates the date in the title line, if
|
|
2442 'hm--html-automatic-new-date' is t and which inserts a
|
|
2443 \"changed comment\" line, if 'hm--html-automatic-changed-comment' is t."
|
|
2444 (if hm--html-automatic-new-date
|
|
2445 (hm--html-new-date))
|
|
2446 (if hm--html-automatic-changed-comment
|
|
2447 (hm--html-insert-changed-comment t)))
|
|
2448
|
|
2449
|
|
2450 (defun hm--html-new-date ()
|
|
2451 "The function sets the date in the title line up."
|
|
2452 (interactive)
|
|
2453 (save-excursion
|
|
2454 (goto-char (point-min))
|
|
2455 (let ((case-fold-search t)
|
|
2456 (end-of-head (if (search-forward "</head>" nil t)
|
|
2457 (point)
|
|
2458 (if (search-forward "<body>" nil t)
|
|
2459 (point)
|
|
2460 (point-max)))))
|
|
2461 (goto-char (point-min))
|
|
2462 (if (re-search-forward
|
|
2463 (concat
|
|
2464 "\\((\\)"
|
|
2465 "\\([ \t]*[0-3]?[0-9]-[A-Z][a-z][a-z]-[0-9][0-9][0-9][0-9][ \t]*\\)"
|
|
2466 "\\()[ \t\n]*</title>\\)")
|
|
2467 end-of-head
|
|
2468 t)
|
|
2469 (progn
|
|
2470 (delete-region (match-beginning 2) (match-end 2))
|
|
2471 (goto-char (match-beginning 2))
|
|
2472 (insert (hm--date)))))))
|
|
2473
|
|
2474
|
|
2475 (defun hm--html-insert-created-comment (&optional noerror)
|
|
2476 "The function inserts a \"created comment\".
|
|
2477 The comment looks like <!-- Created by: Heiko Münkel, 10-Dec-1993 -->.
|
|
2478 The comment will be inserted after the title line.
|
|
2479 An error message is printed, if there is no title line and if
|
|
2480 noerror is nil."
|
|
2481 (interactive)
|
|
2482 (save-excursion
|
|
2483 (goto-char (point-min))
|
|
2484 (let ((case-fold-search t)
|
|
2485 (end-of-head (if (search-forward "</head>" nil t)
|
|
2486 (point)
|
|
2487 (if (search-forward "<body>" nil t)
|
|
2488 (point)
|
|
2489 (point-max)))))
|
|
2490 (goto-char (point-min))
|
|
2491 (if (not (search-forward "</title>" end-of-head t))
|
|
2492 (if (not noerror)
|
|
2493 (error "ERROR: Please insert a title in the document !"))
|
|
2494 (let ((end-of-title-position (point)))
|
|
2495 (if (search-forward "<!-- Created by: " end-of-head t)
|
|
2496 (if (yes-or-no-p
|
|
2497 "Replace the old comment \"<!-- Created by: \" ")
|
|
2498 (progn
|
|
2499 (goto-char (match-beginning 0))
|
|
2500 (kill-line)
|
|
2501 (hm--html-add-comment)
|
|
2502 (insert "Created by: "
|
|
2503 (or hm--html-username (user-full-name))
|
|
2504 ", "
|
|
2505 (hm--date))))
|
|
2506 (newline)
|
|
2507 (hm--html-add-comment)
|
|
2508 (insert "Created by: "
|
|
2509 (or hm--html-username (user-full-name))
|
|
2510 ", "
|
|
2511 (hm--date)
|
|
2512 )))))))
|
|
2513
|
|
2514
|
|
2515 (defun hm--html-insert-changed-comment-1 (newline username)
|
|
2516 "Internal function of 'hm--html-insert-changed-comment'.
|
|
2517 Inserts a newline if NEWLINE is t, before the comment is inserted.
|
|
2518 USERNAME is the name to be inserted in the comment."
|
|
2519 (if newline
|
|
2520 (progn
|
|
2521 ; (end-of-line)
|
|
2522 (newline)))
|
|
2523 (hm--html-add-comment)
|
|
2524 (insert "Changed by: " username ", " (hm--date)))
|
|
2525
|
|
2526 (defun hm--html-insert-changed-comment (&optional noerror)
|
|
2527 "The function inserts a \"changed comment\".
|
|
2528 The comment looks like <!-- Changed by: Heiko Münkel, 10-Dec-1993 -->.
|
|
2529 The comment will be inserted after the last \"changed comment\" line, or,
|
|
2530 if there isn't such a line, after the \"created comment\" line, or,
|
|
2531 after the title line. If there is no title and NOERROR is nil, an error
|
|
2532 message is generated. The line is not inserted after the end of the head
|
|
2533 or the beginning of the body.
|
|
2534 If the last \"changed line\" is from the same author, it is only replaced
|
|
2535 by the new one.
|
|
2536
|
|
2537 Attention: Don't change the format of the lines and don't write anything
|
|
2538 else in such a line !"
|
|
2539 (interactive)
|
|
2540 (save-excursion
|
|
2541 (goto-char (point-min))
|
|
2542 (let ((case-fold-search t)
|
|
2543 (end-of-head (if (search-forward "</head>" nil t)
|
|
2544 (point)
|
|
2545 (if (search-forward "<body>" nil t)
|
|
2546 (point)
|
|
2547 (point-max))))
|
|
2548 (username (or hm--html-username (user-full-name))))
|
|
2549 (goto-char end-of-head)
|
|
2550 (if (search-backward "<!-- Changed by: " nil t)
|
|
2551 (if (string-match username
|
|
2552 (buffer-substring (point)
|
|
2553 (progn
|
|
2554 (end-of-line)
|
|
2555 (point))))
|
|
2556 ;; exchange the comment line
|
|
2557 (progn
|
|
2558 (beginning-of-line)
|
|
2559 (delete-region (point) (progn
|
|
2560 (end-of-line)
|
|
2561 (point)))
|
|
2562 (hm--html-insert-changed-comment-1 nil username))
|
|
2563 ;; new comment line
|
|
2564 (end-of-line)
|
|
2565 (hm--html-insert-changed-comment-1 t username))
|
|
2566 (if (search-backward "<!-- Created by: " nil t)
|
|
2567 (progn
|
|
2568 (end-of-line)
|
|
2569 (hm--html-insert-changed-comment-1 t username))
|
|
2570 (if (search-backward "</title>" nil t)
|
|
2571 (progn
|
|
2572 (goto-char (match-end 0))
|
|
2573 (if (not (looking-at "\n"))
|
|
2574 (progn
|
|
2575 (newline)
|
|
2576 (forward-char -1)))
|
|
2577 (hm--html-insert-changed-comment-1 t username))
|
|
2578 (if (not noerror)
|
|
2579 (error
|
|
2580 "ERROR: Insert at first a title in the document !"))))))))
|
|
2581
|
|
2582
|
|
2583
|
|
2584 ;;; Functions to insert templates
|
|
2585
|
|
2586 (defvar hm--html-template-file-history nil
|
|
2587 "Historvariable for the template files.")
|
|
2588
|
|
2589 (defun hm--html-insert-template (filename)
|
|
2590 "Inserts a templatefile."
|
|
2591 (interactive (list
|
|
2592 (let ((file-name-history hm--html-template-file-history))
|
|
2593 (read-file-name "Templatefile: "
|
|
2594 hm--html-template-dir
|
|
2595 nil
|
|
2596 t
|
|
2597 nil))))
|
|
2598 ; 'hm--html-template-file-history)))
|
|
2599 (insert-file (expand-file-name filename))
|
|
2600 (if hm--html-automatic-expand-templates
|
|
2601 (tmpl-expand-templates-in-buffer))
|
|
2602 (if hm--html-automatic-created-comment
|
|
2603 (hm--html-insert-created-comment t)))
|
|
2604
|
|
2605
|
|
2606
|
|
2607 ;;; Functions for highlighting
|
|
2608
|
|
2609 ;(defun hm--html-toggle-use-highlighting ()
|
|
2610 ; "Toggles the variable html-use-highlighting."
|
|
2611 ; (interactive)
|
|
2612 ; (if html-use-highlighting
|
|
2613 ; (setq html-use-highlighting nil)
|
|
2614 ; (setq html-use-highlighting t)))
|
|
2615
|
|
2616
|
|
2617 ;;; Functions for font lock mode
|
|
2618
|
|
2619 (if html-running-emacs-19
|
|
2620 (progn
|
|
2621 (make-face 'font-lock-comment-face)
|
|
2622 (make-face 'font-lock-doc-string-face)
|
|
2623 (make-face 'font-lock-string-face)
|
|
2624 (or (face-differs-from-default-p 'font-lock-doc-string-face)
|
|
2625 (copy-face 'font-lock-comment-face 'font-lock-doc-string-face))
|
|
2626 (or (face-differs-from-default-p 'font-lock-comment-face)
|
|
2627 (copy-face 'italic 'font-lock-comment-face))
|
|
2628 (or (face-differs-from-default-p 'font-lock-string-face)
|
|
2629 (progn
|
|
2630 (copy-face 'font-lock-doc-string-face 'font-lock-string-face)
|
|
2631 (set-face-underline-p 'font-lock-string-face t)))
|
|
2632 (setq font-lock-comment-face 'font-lock-comment-face)
|
|
2633 ;; (setq font-lock-doc-string-face 'font-lock-doc-string-face)
|
|
2634 (setq font-lock-string-face 'font-lock-string-face)))
|
|
2635
|
|
2636
|
|
2637 ;(defun hm--html-set-font-lock-color ()
|
|
2638 ; "Sets the color for the font lock mode in HTML mode.
|
|
2639 ;This color is used to highlight HTML expressions."
|
|
2640 ; (interactive)
|
|
2641 ; (setq hm--html-font-lock-color
|
|
2642 ; (completing-read "Color: "
|
|
2643 ; '(("grey80")
|
|
2644 ; ("black")
|
|
2645 ; ("red")
|
|
2646 ; ("yellow")
|
|
2647 ; ("blue"))
|
|
2648 ; nil
|
|
2649 ; nil
|
|
2650 ; "black"))
|
|
2651 ; (set-face-foreground 'font-lock-comment-face hm--html-font-lock-color)
|
|
2652 ; (set-face-foreground 'font-lock-string-face hm--html-font-lock-color))
|
|
2653
|
|
2654
|
|
2655 ;;; Functions which determine if an active region exists
|
|
2656
|
|
2657 ;(defvar hm--region-active nil
|
|
2658 ; "t : Region is active.
|
|
2659 ;nil: Region is inactive.")
|
|
2660 ;
|
|
2661 ;
|
|
2662 ;(defun hm--set-hm--region-active ()
|
|
2663 ; (setq hm--region-active t))
|
|
2664 ;
|
|
2665 ;
|
|
2666 ;(defun hm--unset-hm--region-active ()
|
|
2667 ; (setq hm--region-active nil))
|
|
2668
|
|
2669
|
|
2670
|
|
2671 ;;; Functions to insert forms
|
|
2672
|
|
2673 (defun hm--html-form-read-method ()
|
|
2674 "Reads the method for a form."
|
|
2675 (completing-read "Method of the form: "
|
|
2676 '(("POST") ("GET"))
|
|
2677 nil
|
|
2678 t
|
|
2679 "POST"))
|
|
2680
|
|
2681
|
|
2682 (defun hm--html-form-read-action (method)
|
|
2683 "Reads the URL for the action attribute of a form.
|
|
2684 It returns nil if no action attribute is wanted.
|
|
2685 METHOD is the method of the form."
|
|
2686 (if (y-or-n-p "Current document URL as action attribute ? ")
|
|
2687 nil
|
|
2688 (hm--html-read-url "Query server URL: "
|
|
2689 hm--html-url-alist
|
|
2690 (function
|
|
2691 (lambda (table-element-list)
|
|
2692 (hm--html-read-url-predicate table-element-list
|
|
2693 (car
|
|
2694 (read-from-string
|
|
2695 method)))))
|
|
2696 nil
|
|
2697 nil)))
|
|
2698
|
|
2699
|
|
2700 (defun hm--html-add-form (&optional method)
|
|
2701 "Adds the HTML tags for a form.
|
|
2702 The function asks only for a method, if METHOD is nil, otherwise
|
|
2703 the METHOD must have one of the values \"GET\" or \"POST\"."
|
|
2704 (interactive)
|
|
2705 (let* ((method (or method (hm--html-form-read-method)))
|
|
2706 (action (hm--html-form-read-action method)))
|
|
2707 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
2708 (concat "<FORM METHOD=\""
|
|
2709 method
|
|
2710 "\""
|
|
2711 (if action
|
|
2712 (concat " ACTION=\""
|
|
2713 action
|
|
2714 "\"")
|
|
2715 "")
|
|
2716 ">")
|
|
2717 'hm--html-insert-end-tag-with-newline
|
|
2718 "</FORM>")))
|
|
2719
|
|
2720
|
|
2721 (defun hm--html-add-form-to-region (&optional method)
|
|
2722 "Adds the HTML tags for a form to a region.
|
|
2723 The function asks only for a method, if METHOD is nil, otherwise
|
|
2724 the METHOD must have one of the values \"GET\" or \"POST\"."
|
|
2725 (interactive)
|
|
2726 (let* ((method (or method (hm--html-form-read-method)))
|
|
2727 (action (hm--html-form-read-action method)))
|
|
2728 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
2729 (concat "<FORM METHOD=\""
|
|
2730 method
|
|
2731 "\""
|
|
2732 (if action
|
|
2733 (concat " ACTION=\""
|
|
2734 action
|
|
2735 "\"")
|
|
2736 "")
|
|
2737 ">")
|
|
2738 'hm--html-insert-end-tag-with-newline
|
|
2739 "</FORM>")))
|
|
2740
|
|
2741
|
|
2742 (defun hm--html-form-read-name (&optional last-name)
|
|
2743 "Reads the name for an input tag."
|
|
2744 (read-string "Symbolic name: " last-name))
|
|
2745
|
|
2746
|
|
2747 (defun hm--html-form-read-value (prompt &optional initial-contents)
|
|
2748 "Reads the value for an input tag."
|
|
2749 (read-string prompt initial-contents))
|
|
2750
|
|
2751
|
|
2752 (defun hm--html-form-read-checked ()
|
|
2753 "Reads whether a button is checked by default or not."
|
|
2754 (y-or-n-p "Should the button be checked by default ? "))
|
|
2755
|
|
2756
|
|
2757 (defun hm--html-form-read-size ()
|
|
2758 "Reads the size of text entry fields of input tags."
|
|
2759 (if (y-or-n-p "Defaultsize of the Inputfield ? ")
|
|
2760 nil
|
|
2761 (format "%d,%d"
|
|
2762 (read-number "Width of the input field: " t)
|
|
2763 (read-number "Height of the input field: " t))))
|
|
2764
|
|
2765
|
|
2766 (defun hm--html-form-read-maxlength ()
|
|
2767 "Reads the maxlength of text entry fields of input tags."
|
|
2768 (let ((maxlength (read-number "Maximum number of chars (0 = unlimited): "
|
|
2769 t)))
|
|
2770 (if (<= maxlength 0)
|
|
2771 nil
|
|
2772 (int-to-string maxlength))))
|
|
2773
|
|
2774
|
|
2775 (defun hm--html-form-read-src (prompt &optional initial-contents)
|
|
2776 "Reads the src for an input tag."
|
|
2777 (read-string prompt initial-contents))
|
|
2778
|
|
2779
|
|
2780 (defun hm--html-form-add-input (type
|
|
2781 name
|
|
2782 value
|
|
2783 checked
|
|
2784 size
|
|
2785 maxlength
|
|
2786 &optional src)
|
|
2787 "Adds the HTML tags for an input tag to the buffer."
|
|
2788 (hm--html-insert-start-tag (concat "<INPUT TYPE=\""
|
|
2789 type
|
|
2790 "\""
|
|
2791 (if (and name (not (string= name "")))
|
|
2792 (concat " NAME=\"" name "\""))
|
|
2793 (if (and value (not (string= value "")))
|
|
2794 (concat " VALUE=\"" value "\""))
|
|
2795 (if checked " CHECKED")
|
|
2796 (if (and size (not (string= size "")))
|
|
2797 (concat " SIZE=" size))
|
|
2798 (if (and maxlength
|
|
2799 (not (string= maxlength "")))
|
|
2800 (concat " MAXLENGTH="
|
|
2801 maxlength
|
|
2802 ))
|
|
2803 (if (and src
|
|
2804 (not (string= src "")))
|
|
2805 (concat " SRC=\""
|
|
2806 src
|
|
2807 "\""))
|
|
2808 ">")))
|
|
2809
|
|
2810
|
|
2811 (defun hm--html-form-add-input-text (name value size maxlength)
|
|
2812 "Adds the HTML tags for a text input field."
|
|
2813 (interactive (list (hm--html-form-read-name)
|
|
2814 (hm--html-form-read-value "Defaultvalue: ")
|
|
2815 (hm--html-form-read-size)
|
|
2816 (hm--html-form-read-maxlength)))
|
|
2817 (hm--html-form-add-input "text" name value nil size maxlength))
|
|
2818
|
|
2819
|
|
2820 (defun hm--html-form-add-input-password (name value size maxlength)
|
|
2821 "Adds the HTML tags for a password input field."
|
|
2822 (interactive (list (hm--html-form-read-name)
|
|
2823 (hm--html-form-read-value "Defaultvalue: ")
|
|
2824 (hm--html-form-read-size)
|
|
2825 (hm--html-form-read-maxlength)))
|
|
2826 (hm--html-form-add-input "password" name value nil size maxlength))
|
|
2827
|
|
2828
|
|
2829 (defun hm--html-form-add-input-integer (name value size maxlength)
|
|
2830 "Adds the HTML tags for a integer input field."
|
|
2831 (interactive (list (hm--html-form-read-name)
|
|
2832 (hm--html-form-read-value "Defaultvalue: ")
|
|
2833 (hm--html-form-read-size)
|
|
2834 (hm--html-form-read-maxlength)))
|
|
2835 (hm--html-form-add-input "int" name value nil size maxlength))
|
|
2836
|
|
2837
|
|
2838 (defun hm--html-form-add-input-float (name value size maxlength)
|
|
2839 "Adds the HTML tags for a float input field."
|
|
2840 (interactive (list (hm--html-form-read-name)
|
|
2841 (hm--html-form-read-value "Defaultvalue: ")
|
|
2842 (hm--html-form-read-size)
|
|
2843 (hm--html-form-read-maxlength)))
|
|
2844 (hm--html-form-add-input "float" name value nil size maxlength))
|
|
2845
|
|
2846
|
|
2847 (defun hm--html-form-add-input-date (name value size maxlength)
|
|
2848 "Adds the HTML tags for a date input field."
|
|
2849 (interactive (list (hm--html-form-read-name)
|
|
2850 (hm--html-form-read-value "Defaultvalue: ")
|
|
2851 (hm--html-form-read-size)
|
|
2852 (hm--html-form-read-maxlength)))
|
|
2853 (hm--html-form-add-input "date" name value nil size maxlength))
|
|
2854
|
|
2855
|
|
2856 (defun hm--html-form-add-input-url (name value size maxlength)
|
|
2857 "Adds the HTML tags for a url input field."
|
|
2858 (interactive (list (hm--html-form-read-name)
|
|
2859 (hm--html-form-read-value "Defaultvalue: ")
|
|
2860 (hm--html-form-read-size)
|
|
2861 (hm--html-form-read-maxlength)))
|
|
2862 (hm--html-form-add-input "url" name value nil size maxlength))
|
|
2863
|
|
2864
|
|
2865 (defun hm--html-form-add-input-scribble (name value size maxlength)
|
|
2866 "Adds the HTML tags for a scribble input field."
|
|
2867 (interactive (list (hm--html-form-read-name)
|
|
2868 (hm--html-form-read-value "Defaultvalue: ")
|
|
2869 (hm--html-form-read-size)
|
|
2870 (hm--html-form-read-maxlength)))
|
|
2871 (hm--html-form-add-input "scribble" name value nil size maxlength))
|
|
2872
|
|
2873
|
|
2874 (defun hm--html-form-add-input-checkbox (name value checked)
|
|
2875 "Adds the HTML tags for a checkbox button."
|
|
2876 (interactive (list (hm--html-form-read-name)
|
|
2877 (hm--html-form-read-value "Checkbox value: ")
|
|
2878 (hm--html-form-read-checked)))
|
|
2879 (hm--html-form-add-input "checkbox" name value checked nil nil))
|
|
2880
|
|
2881
|
|
2882 (defvar hm--html-last-radio-button-name nil
|
|
2883 "Name of the last radio button.")
|
|
2884
|
|
2885
|
|
2886 (defun hm--html-form-add-input-radio (name value checked)
|
|
2887 "Adds the HTML tags for a radio button."
|
|
2888 (interactive (list (hm--html-form-read-name hm--html-last-radio-button-name)
|
|
2889 (hm--html-form-read-value "Radiobutton value: ")
|
|
2890 (hm--html-form-read-checked)))
|
|
2891 (setq hm--html-last-radio-button-name name)
|
|
2892 (hm--html-form-add-input "radio" name value checked nil nil))
|
|
2893
|
|
2894
|
|
2895 (defun hm--html-form-add-input-submit (value)
|
|
2896 "Adds the HTML tags for a submit input field."
|
|
2897 (interactive (list (hm--html-form-read-value
|
|
2898 "Label of the submit button: "
|
|
2899 "Submit")))
|
|
2900 (hm--html-form-add-input "submit" nil value nil nil nil))
|
|
2901
|
|
2902
|
|
2903 (defun hm--html-form-add-input-image (name src)
|
|
2904 "Adds the HTML tags for an image input field."
|
|
2905 (interactive (list (hm--html-form-read-name)
|
|
2906 (hm--html-read-url "Image URL: "
|
|
2907 hm--html-url-alist
|
|
2908 (function
|
|
2909 (lambda (table-element-list)
|
|
2910 (hm--html-read-url-predicate
|
|
2911 table-element-list
|
|
2912 'IMAGE)))
|
|
2913 nil
|
|
2914 nil)))
|
|
2915 (hm--html-form-add-input "IMAGE"
|
|
2916 name
|
|
2917 nil
|
|
2918 nil
|
|
2919 nil
|
|
2920 nil
|
|
2921 src))
|
|
2922
|
|
2923
|
|
2924 (defun hm--html-form-add-input-audio (name src)
|
|
2925 "Adds the HTML tags for an audio input field."
|
|
2926 (interactive (list (hm--html-form-read-name)
|
|
2927 (hm--html-read-url "Audio URL: "
|
|
2928 hm--html-url-alist
|
|
2929 (function
|
|
2930 (lambda (table-element-list)
|
|
2931 (hm--html-read-url-predicate
|
|
2932 table-element-list
|
|
2933 'AUDIO)))
|
|
2934 nil
|
|
2935 nil)))
|
|
2936 (hm--html-form-add-input "AUDIO"
|
|
2937 name
|
|
2938 nil
|
|
2939 nil
|
|
2940 nil
|
|
2941 nil
|
|
2942 src))
|
|
2943
|
|
2944
|
|
2945 (defun hm--html-form-add-input-reset (value)
|
|
2946 "Adds the HTML tags for a reset input field."
|
|
2947 (interactive (list (hm--html-form-read-value
|
|
2948 "Label of the reset button: "
|
|
2949 "Reset")))
|
|
2950 (hm--html-form-add-input "reset" nil value nil nil nil))
|
|
2951
|
|
2952
|
|
2953 (defun hm--html-form-add-input-isindex (size)
|
|
2954 "Adds the HTML tags for an isindex input field.
|
|
2955 Size is the value of the input field wide."
|
|
2956 (interactive "nWidth of the input field (i.e: 20): ")
|
|
2957 (hm--html-insert-start-tag (concat "<INPUT NAME=\"isindex\""
|
|
2958 (if (= size 20)
|
|
2959 ">"
|
|
2960 (format
|
|
2961 " SIZE=%d>"
|
|
2962 size)))))
|
|
2963
|
|
2964
|
|
2965 (defun hm--html-form-add-select-option-menu (name)
|
|
2966 "Adds the HTML tags for a select option menu to the buffer."
|
|
2967 (interactive (list (hm--html-form-read-name)))
|
|
2968 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
2969 (concat "<SELECT NAME=\"" name "\">")
|
|
2970 'hm--html-insert-end-tag-with-newline
|
|
2971 "</SELECT>"
|
|
2972 'hm--html-insert-start-tag
|
|
2973 "<OPTION> "))
|
|
2974
|
|
2975
|
|
2976 (defun hm--html-form-add-select-scrolled-list (name listsize multiple)
|
|
2977 "Adds the HTML tags for a select scrolled list to the buffer."
|
|
2978 (interactive (list (hm--html-form-read-name)
|
|
2979 (read-number "No of visible items (>1): " t)
|
|
2980 (y-or-n-p "Multiple selections allowed ? ")))
|
|
2981 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
2982 (concat "<SELECT NAME=\""
|
|
2983 name
|
|
2984 "\" SIZE="
|
|
2985 (int-to-string listsize)
|
|
2986 (if multiple
|
|
2987 " MULTIPLE")
|
|
2988 ">")
|
|
2989 'hm--html-insert-end-tag-with-newline
|
|
2990 "</SELECT>"
|
|
2991 'hm--html-insert-start-tag
|
|
2992 "<OPTION> "))
|
|
2993
|
|
2994
|
|
2995 (defun hm--html-form-add-select-option (selected-by-default)
|
|
2996 "Adds the tags for an option in a select form menu."
|
|
2997 (interactive (list (y-or-n-p "Select this option by default ? ")))
|
|
2998 (hm--html-insert-end-tag-with-newline (concat "<OPTION"
|
|
2999 (if selected-by-default
|
|
3000 " SELECTED")
|
|
3001 "> ")))
|
|
3002
|
|
3003
|
|
3004 (defun hm--html-form-add-textarea (name rows columns)
|
|
3005 "Adds the tags for a textarea tag."
|
|
3006 (interactive (list (hm--html-form-read-name)
|
|
3007 (read-number "Number of Rows of the Textarea: " t)
|
|
3008 (read-number "Number of Columns of the Textarea: " t)))
|
|
3009 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
3010 (concat "<TEXTAREA NAME=\""
|
|
3011 name
|
|
3012 "\" ROWS="
|
|
3013 (int-to-string rows)
|
|
3014 " COLS="
|
|
3015 (int-to-string columns)
|
|
3016 ">")
|
|
3017 'hm--html-insert-end-tag
|
|
3018 "</TEXTAREA>"))
|
|
3019
|
|
3020
|
|
3021 ;;; Functions to insert tables
|
|
3022
|
|
3023 (defun hm--html-add-table (border compact)
|
|
3024 "Add the HTML tags for a table frame.
|
|
3025 If BORDER is t, then the table should be drawn with a border.
|
|
3026 If COMPACT is t, then the table should be drawn in a smaller size."
|
|
3027 (interactive (list (y-or-n-p "Use a table with a border? ")
|
|
3028 (y-or-n-p "Use a small table? ")))
|
|
3029 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
|
|
3030 (concat "<TABLE"
|
|
3031 (if border " border" "")
|
|
3032 (if compact " compact" "")
|
|
3033 ">")
|
|
3034 'hm--html-insert-start-tag-with-newline
|
|
3035 "</TABLE>")
|
|
3036 (backward-char))
|
|
3037
|
|
3038
|
|
3039 (defun hm--html-add-table-to-region (border compact)
|
|
3040 "Add the HTML tags for a table frame.
|
|
3041 If BORDER is t, then the table should be drawn with a border.
|
|
3042 If COMPACT is t, then the table should be drawn in a smaller size."
|
|
3043 (interactive (list (y-or-n-p "Use a table with a border? ")
|
|
3044 (y-or-n-p "Use a small table? ")))
|
|
3045 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
|
|
3046 (concat "<TABLE"
|
|
3047 (if border " border" "")
|
|
3048 (if compact " compact" "")
|
|
3049 ">")
|
|
3050 'hm--html-insert-start-tag-with-newline
|
|
3051 "</TABLE>"))
|
|
3052
|
|
3053
|
|
3054 (defun hm--html-add-table-title (top)
|
|
3055 "Adds the HTML tag for a table title at the current point.
|
|
3056 If TOP is t, then the title will positioned at the top instead of the
|
|
3057 bottom of the table."
|
|
3058 (interactive (list (y-or-n-p "Put the title at the table top? ")))
|
|
3059 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
3060 (concat "\n<CAPTION"
|
|
3061 (if top " align=top" " align=bottom")
|
|
3062 "> ")
|
|
3063 'hm--html-insert-end-tag
|
|
3064 " </CAPTION>"))
|
|
3065
|
|
3066
|
|
3067 (defun hm--html-add-table-title-to-region (top)
|
|
3068 "Adds the HTML tag for a table title to the region.
|
|
3069 If TOP is t, then the title will positioned at the top instead of the
|
|
3070 bottom of the table."
|
|
3071 (interactive (list (y-or-n-p "Put the title at the table top? ")))
|
|
3072 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
3073 (concat "<CAPTION"
|
|
3074 (if top " align=top" " align=bottom")
|
|
3075 "> ")
|
|
3076 'hm--html-insert-end-tag
|
|
3077 " </CAPTION>"))
|
|
3078
|
|
3079
|
|
3080 (defvar hm--html-table-alignment-alist '(("default")
|
|
3081 ("left")
|
|
3082 ("right")
|
|
3083 ("center"))
|
|
3084 "Alist with table alignments.")
|
|
3085
|
|
3086 (defun hm--html-table-read-cell-entries-and-alignments (cell-no
|
|
3087 no-of-cells
|
|
3088 &optional
|
|
3089 alignment-list)
|
|
3090 "Reads the alignments and the entries for NO-OF-CELLS cells.
|
|
3091 The return is a list with strings of the form: \"align=left> entry\".
|
|
3092 CELL-NO is the current cell no.
|
|
3093 If (car ALIGNMENT-LIST) is non-nil, then it is used as alignment."
|
|
3094 (if (> cell-no no-of-cells)
|
|
3095 nil
|
|
3096 (let ((alignment
|
|
3097 (or (car alignment-list)
|
|
3098 (completing-read (format "Alignment of the %d. cell: "
|
|
3099 cell-no)
|
|
3100 hm--html-table-alignment-alist
|
|
3101 nil
|
|
3102 t
|
|
3103 "default")))
|
|
3104 (entry (read-string (format "Entry of the %d. cell: " cell-no))))
|
|
3105 (if (string= "default" alignment)
|
|
3106 (setq alignment "")
|
|
3107 (setq alignment (concat " align=" alignment)))
|
|
3108 (cons (concat alignment "> " entry)
|
|
3109 (hm--html-table-read-cell-entries-and-alignments (1+ cell-no)
|
|
3110 no-of-cells
|
|
3111 (cdr
|
|
3112 alignment-list))
|
|
3113 ))))
|
|
3114
|
|
3115 (defun hm--html-add-table-header (no-of-cells)
|
|
3116 "Adds the HTML tags for a complete simple table header line.
|
|
3117 It asks for the number of cells and the allignment of the cells.
|
|
3118 The number of cells can also be given as prefix argument."
|
|
3119 (interactive "NNo of cells in a row: ")
|
|
3120 (if (< no-of-cells 1)
|
|
3121 (error "ERROR: There must be at least one cell in a row!"))
|
|
3122 (hm--html-add-tags
|
|
3123 'hm--html-insert-end-tag-with-newline
|
|
3124 (concat
|
|
3125 (mapconcat '(lambda (entry)
|
|
3126 (concat "<TH" entry))
|
|
3127 (hm--html-table-read-cell-entries-and-alignments 1 no-of-cells)
|
|
3128 " ")
|
|
3129 " <TR>")))
|
|
3130
|
|
3131
|
|
3132 (defun hm--html-add-first-table-row (no-of-cells)
|
|
3133 "Adds the HTML tags for a table row.
|
|
3134 It asks for the number of cells and the allignment of the cells.
|
|
3135 The number of cells can also be given as prefix argument."
|
|
3136 (interactive "NNo of cells in a row: ")
|
|
3137 (if (< no-of-cells 1)
|
|
3138 (error "ERROR: There must be at least one cell in a row!"))
|
|
3139 (hm--html-add-tags
|
|
3140 'hm--html-insert-end-tag-with-newline
|
|
3141 (concat "<TD" (car (hm--html-table-read-cell-entries-and-alignments 1 1))
|
|
3142 " "
|
|
3143 (if (<= no-of-cells 1)
|
|
3144 "<TR>"
|
|
3145 (concat
|
|
3146 (mapconcat '(lambda (entry)
|
|
3147 (concat "<TD" entry))
|
|
3148 (hm--html-table-read-cell-entries-and-alignments
|
|
3149 2 no-of-cells)
|
|
3150 " ")
|
|
3151 " <TR>")))))
|
|
3152
|
|
3153
|
|
3154 (defun hm--html-table-get-previous-alignments ()
|
|
3155 "Returns a list with the alignments of the previous table row.
|
|
3156 The row must be a data row and not a header row!
|
|
3157 An example for the return list: '(\"left\" \"default\" \"center\" \"right\")"
|
|
3158 (save-excursion
|
|
3159 (let* ((point-of-view (point))
|
|
3160 (end-of-last-row (search-backward "<tr>" nil t))
|
|
3161 (begin-of-last-row (progn (search-backward "<tr" nil t)
|
|
3162 (search-forward "<td" nil t)
|
|
3163 (match-beginning 0)))
|
|
3164 (alignment-list nil))
|
|
3165 (if (not (search-forward "<td" end-of-last-row t))
|
|
3166 (error "Error: No previous data row found!")
|
|
3167 (goto-char end-of-last-row)
|
|
3168 (while (> (point) begin-of-last-row)
|
|
3169 (let ((cell-start
|
|
3170 (search-backward-regexp "\\(<td[^>]*>\\)\\|\\(<th[^>]*>\\)"
|
|
3171 begin-of-last-row
|
|
3172 t)))
|
|
3173 (if (not cell-start)
|
|
3174 (goto-char begin-of-last-row)
|
|
3175 (setq alignment-list
|
|
3176 (cons
|
|
3177 (if (search-forward-regexp "\\(align=\\)\\([^ \t\n>]*\\)"
|
|
3178 (match-end 0)
|
|
3179 t)
|
|
3180 (buffer-substring (match-beginning 2)
|
|
3181 (match-end 2))
|
|
3182 "default")
|
|
3183 alignment-list))
|
|
3184 (goto-char cell-start))))
|
|
3185 alignment-list))))
|
|
3186
|
|
3187
|
|
3188 (defun hm--html-add-additional-table-row ()
|
|
3189 "Adds the HTML tags for a table row.
|
|
3190 It tries to detect the number of cells and their alignments
|
|
3191 from existing rows of the table."
|
|
3192 (interactive)
|
|
3193 (let* ((old-alignment-list (hm--html-table-get-previous-alignments))
|
|
3194 (no-of-cells (length old-alignment-list)))
|
|
3195 (hm--html-add-tags
|
|
3196 'hm--html-insert-end-tag-with-newline
|
|
3197 (concat "<TD" (car (hm--html-table-read-cell-entries-and-alignments
|
|
3198 1
|
|
3199 1
|
|
3200 old-alignment-list))
|
|
3201 " "
|
|
3202 (if (<= no-of-cells 1)
|
|
3203 "<TR>"
|
|
3204 (concat
|
|
3205 (mapconcat '(lambda (entry)
|
|
3206 (concat "<TD" entry))
|
|
3207 (hm--html-table-read-cell-entries-and-alignments
|
|
3208 2
|
|
3209 no-of-cells
|
|
3210 (cdr old-alignment-list))
|
|
3211 " ")
|
|
3212 " <TR>"))))))
|
|
3213
|
|
3214
|
|
3215 (defun hm--html-add-row-entry (alignment)
|
|
3216 "Adds the HTML tag for a table row entry at the current point."
|
|
3217 (interactive (list (completing-read "Alignment of the cell: "
|
|
3218 hm--html-table-alignment-alist
|
|
3219 nil
|
|
3220 t
|
|
3221 "default")))
|
|
3222 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
3223 (concat "<TD"
|
|
3224 (if (string= "default" alignment)
|
|
3225 "> "
|
|
3226 (concat " align=" alignment "> ")))))
|
|
3227
|
|
3228
|
|
3229 (defun hm--html-add-header-entry (alignment)
|
|
3230 "Adds the HTML tag for a table header entry at the current point."
|
|
3231 (interactive (list (completing-read "Alignment of the cell: "
|
|
3232 hm--html-table-alignment-alist
|
|
3233 nil
|
|
3234 t
|
|
3235 "default")))
|
|
3236 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
3237 (concat "<TH"
|
|
3238 (if (string= "default" alignment)
|
|
3239 "> "
|
|
3240 (concat " align=" alignment "> ")))))
|
|
3241
|
|
3242
|
|
3243 (defun hm--html-add-row-frame (alignment)
|
|
3244 "Adds the HTML tags for a table row start and end at the current point."
|
|
3245 (interactive (list (completing-read "Alignment of the start cell: "
|
|
3246 hm--html-table-alignment-alist
|
|
3247 nil
|
|
3248 t
|
|
3249 "default")))
|
|
3250 (hm--html-add-tags 'hm--html-insert-start-tag
|
|
3251 (concat "<TD"
|
|
3252 (if (string= "default" alignment)
|
|
3253 "> "
|
|
3254 (concat " align=" alignment "> ")))
|
|
3255 'hm--html-insert-end-tag
|
|
3256 "<TR>"))
|
|
3257
|
|
3258
|
|
3259 (defun hm--html-add-row-frame-to-region (alignment)
|
|
3260 "Adds the HTML tags for a table row start and end to the current region."
|
|
3261 (interactive (list (completing-read "Alignment of the start cell: "
|
|
3262 hm--html-table-alignment-alist
|
|
3263 nil
|
|
3264 t
|
|
3265 "default")))
|
|
3266 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
|
|
3267 (concat "<TD"
|
|
3268 (if (string= "default" alignment)
|
|
3269 "> "
|
|
3270 (concat " align=" alignment "> ")))
|
|
3271 'hm--html-insert-end-tag
|
|
3272 " <TR>"))
|
|
3273
|
|
3274
|
|
3275 (defun hm--html-table-add-colspan-attribute (columns)
|
|
3276 "Adds a colspawn attribute to a table cell.
|
|
3277 A prefix arg is used as no of COLUMNS."
|
|
3278 (interactive "NNo of columns, spaned by this cell: ")
|
|
3279 (save-excursion
|
|
3280 (if (and (search-backward "<" nil t)
|
|
3281 (search-forward-regexp "<[ \t\n]*\\(th\\)\\|\\(td\\)" nil t))
|
|
3282 (if (search-forward-regexp "\\([ \t\n]+colspan=\\)\\([^ \t\n>]*\\)"
|
|
3283 nil
|
|
3284 t)
|
|
3285 (progn
|
|
3286 (delete-region (match-beginning 2) (match-end 2))
|
|
3287 (insert (format "\"%d\"" columns)))
|
|
3288 (insert (format " colspan=\"%d\"" columns)))
|
|
3289 (error "ERROR: Point not in a table cell!"))))
|
|
3290
|
|
3291
|
|
3292 (defun hm--html-table-add-rowspan-attribute (rows)
|
|
3293 "Adds a rowspan attribute to a table cell.
|
|
3294 A prefix arg is used as no of ROWS."
|
|
3295 (interactive "NNo of rows, spaned by this cell: ")
|
|
3296 (save-excursion
|
|
3297 (if (and (search-backward "<" nil t)
|
|
3298 (search-forward-regexp "<[ \t\n]*\\(th\\)\\|\\(td\\)" nil t))
|
|
3299 (if (search-forward-regexp "\\([ \t\n]+rowspan=\\)\\([^ \t\n>]*\\)"
|
|
3300 nil
|
|
3301 t)
|
|
3302 (progn
|
|
3303 (delete-region (match-beginning 2) (match-end 2))
|
|
3304 (insert (format "\"%d\"" rows)))
|
|
3305 (insert (format " rowspan=\"%d\"" rows)))
|
|
3306 (error "ERROR: Point not in a table cell!"))))
|
|
3307
|
|
3308
|
|
3309 ;;; ISO-Characters for Emacs HTML-mode (Berthold Crysmann)
|
|
3310
|
|
3311 (defun hm--html_ue ()
|
|
3312 "Insert the character 'ue'."
|
|
3313 (interactive)
|
|
3314 (insert "ü"))
|
|
3315
|
|
3316 (defun hm--html_oe ()
|
|
3317 "Insert the character 'oe'."
|
|
3318 (interactive)
|
|
3319 (insert "ö"))
|
|
3320
|
|
3321 (defun hm--html_ae ()
|
|
3322 "Insert the character 'ae'."
|
|
3323 (interactive)
|
|
3324 (insert "ä"))
|
|
3325
|
|
3326 (defun hm--html_aa ()
|
|
3327 "Insert the character 'aa'."
|
|
3328 (interactive)
|
|
3329 (insert "å"))
|
|
3330
|
|
3331 (defun hm--html_Ue ()
|
|
3332 "Insert the character 'Ue'."
|
|
3333 (interactive)
|
|
3334 (insert "Ü"))
|
|
3335
|
|
3336 (defun hm--html_Oe ()
|
|
3337 "Insert the character 'Oe'."
|
|
3338 (interactive)
|
|
3339 (insert "Ö"))
|
|
3340
|
|
3341 (defun hm--html_Ae ()
|
|
3342 "Insert the character 'Ae'."
|
|
3343 (interactive)
|
|
3344 (insert "Ä"))
|
|
3345
|
|
3346 (defun hm--html_Aa ()
|
|
3347 "Insert the character 'Aa'."
|
|
3348 (interactive)
|
|
3349 (insert "Å"))
|
|
3350
|
|
3351 (defun hm--html_sz ()
|
|
3352 "Insert the character 'sz'."
|
|
3353 (interactive)
|
|
3354 (insert "ß"))
|
|
3355
|
|
3356 (defun hm--html_aacute ()
|
|
3357 "Insert the character 'aacute'."
|
|
3358 (interactive)
|
|
3359 (insert "á"))
|
|
3360
|
|
3361 (defun hm--html_eacute ()
|
|
3362 "Insert the character 'eacute'."
|
|
3363 (interactive)
|
|
3364 (insert "é"))
|
|
3365
|
|
3366 (defun hm--html_iacute ()
|
|
3367 "Insert the character 'iacute'."
|
|
3368 (interactive)
|
|
3369 (insert "í"))
|
|
3370
|
|
3371 (defun hm--html_oacute ()
|
|
3372 "Insert the character 'oacute'."
|
|
3373 (interactive)
|
|
3374 (insert "ó"))
|
|
3375
|
|
3376 (defun hm--html_uacute ()
|
|
3377 "Insert the character 'uacute'."
|
|
3378 (interactive)
|
|
3379 (insert "ú"))
|
|
3380
|
|
3381 (defun hm--html_Aacute ()
|
|
3382 "Insert the character 'Aacute'."
|
|
3383 (interactive)
|
|
3384 (insert "á"))
|
|
3385
|
|
3386 (defun hm--html_Eacute ()
|
|
3387 "Insert the character 'Eacute'."
|
|
3388 (interactive)
|
|
3389 (insert "é"))
|
|
3390
|
|
3391 (defun hm--html_Iacute ()
|
|
3392 "Insert the character 'Iacute'."
|
|
3393 (interactive)
|
|
3394 (insert "í"))
|
|
3395
|
|
3396 (defun hm--html_Oacute ()
|
|
3397 "Insert the character 'Oacute'."
|
|
3398 (interactive)
|
|
3399 (insert "ó"))
|
|
3400
|
|
3401 (defun hm--html_Uacute ()
|
|
3402 "Insert the character 'Uacute'."
|
|
3403 (interactive)
|
|
3404 (insert "ú"))
|
|
3405
|
|
3406 (defun hm--html_agrave ()
|
|
3407 "Insert the character 'agrave'."
|
|
3408 (interactive)
|
|
3409 (insert "à"))
|
|
3410
|
|
3411 (defun hm--html_egrave ()
|
|
3412 "Insert the character 'egrave'."
|
|
3413 (interactive)
|
|
3414 (insert "è"))
|
|
3415
|
|
3416 (defun hm--html_igrave ()
|
|
3417 "Insert the character 'igrave'."
|
|
3418 (interactive)
|
|
3419 (insert "ì"))
|
|
3420
|
|
3421 (defun hm--html_ograve ()
|
|
3422 "Insert the character 'ograve'."
|
|
3423 (interactive)
|
|
3424 (insert "ò"))
|
|
3425
|
|
3426 (defun hm--html_ugrave ()
|
|
3427 "Insert the character 'ugrave'."
|
|
3428 (interactive)
|
|
3429 (insert "ù"))
|
|
3430
|
|
3431 (defun hm--html_Agrave ()
|
|
3432 "Insert the character 'Agrave'."
|
|
3433 (interactive)
|
|
3434 (insert "À"))
|
|
3435
|
|
3436 (defun hm--html_Egrave ()
|
|
3437 "Insert the character 'Egrave'."
|
|
3438 (interactive)
|
|
3439 (insert "È"))
|
|
3440
|
|
3441 (defun hm--html_Igrave ()
|
|
3442 "Insert the character 'Igrave'."
|
|
3443 (interactive)
|
|
3444 (insert "Ì"))
|
|
3445
|
|
3446 (defun hm--html_Ograve ()
|
|
3447 "Insert the character 'Ograve'."
|
|
3448 (interactive)
|
|
3449 (insert "Ò"))
|
|
3450
|
|
3451 (defun hm--html_Ugrave ()
|
|
3452 "Insert the character 'Ugrave'."
|
|
3453 (interactive)
|
|
3454 (insert "Ù"))
|
|
3455
|
|
3456 (defun hm--html_ccedilla ()
|
|
3457 "Insert the character 'ccedilla'."
|
|
3458 (interactive)
|
|
3459 (insert "çla;"))
|
|
3460
|
|
3461 (defun hm--html_Ccedilla ()
|
|
3462 "Insert the character 'Ccedilla'."
|
|
3463 (interactive)
|
|
3464 (insert "Çla;"))
|
|
3465
|
|
3466 (defun hm--html_atilde ()
|
|
3467 "Insert the character 'atilde'."
|
|
3468 (interactive)
|
|
3469 (insert "ã"))
|
|
3470
|
|
3471 (defun hm--html_otilde ()
|
|
3472 "Insert the character 'otilde'."
|
|
3473 (interactive)
|
|
3474 (insert "õ"))
|
|
3475
|
|
3476 (defun hm--html_ntilde ()
|
|
3477 "Insert the character 'ntilde'."
|
|
3478 (interactive)
|
|
3479 (insert "ñ"))
|
|
3480
|
|
3481 (defun hm--html_Atilde ()
|
|
3482 "Insert the character 'Atilde'."
|
|
3483 (interactive)
|
|
3484 (insert "Ã"))
|
|
3485
|
|
3486 (defun hm--html_Otilde ()
|
|
3487 "Insert the character 'Otilde'."
|
|
3488 (interactive)
|
|
3489 (insert "Õ"))
|
|
3490
|
|
3491 (defun hm--html_Ntilde ()
|
|
3492 "Insert the character 'Ntilde'."
|
|
3493 (interactive)
|
|
3494 (insert "Ñ"))
|
|
3495
|
|
3496 (defun hm--html_acircumflex ()
|
|
3497 "Insert the character 'acircumflex'."
|
|
3498 (interactive)
|
|
3499 (insert "âumflex;"))
|
|
3500
|
|
3501 (defun hm--html_ecircumflex ()
|
|
3502 "Insert the character 'ecircumflex'."
|
|
3503 (interactive)
|
|
3504 (insert "êumflex;"))
|
|
3505
|
|
3506 (defun hm--html_icircumflex ()
|
|
3507 "Insert the character 'icircumflex'."
|
|
3508 (interactive)
|
|
3509 (insert "îumflex;"))
|
|
3510
|
|
3511 (defun hm--html_ocircumflex ()
|
|
3512 "Insert the character 'ocircumflex'."
|
|
3513 (interactive)
|
|
3514 (insert "ôumflex;"))
|
|
3515
|
|
3516 (defun hm--html_ucircumflex ()
|
|
3517 "Insert the character 'ucircumflex'."
|
|
3518 (interactive)
|
|
3519 (insert "ûumflex;"))
|
|
3520
|
|
3521 (defun hm--html_Acircumflex ()
|
|
3522 "Insert the character 'Acircumflex'."
|
|
3523 (interactive)
|
|
3524 (insert "Âumflex;"))
|
|
3525
|
|
3526 (defun hm--html_Ecircumflex ()
|
|
3527 "Insert the character 'Ecircumflex'."
|
|
3528 (interactive)
|
|
3529 (insert "Êumflex;"))
|
|
3530
|
|
3531 (defun hm--html_Icircumflex ()
|
|
3532 "Insert the character 'Icircumflex'."
|
|
3533 (interactive)
|
|
3534 (insert "Îumflex;"))
|
|
3535
|
|
3536 (defun hm--html_Ocircumflex ()
|
|
3537 "Insert the character 'Ocircumflex'."
|
|
3538 (interactive)
|
|
3539 (insert "Ôumflex;"))
|
|
3540
|
|
3541 (defun hm--html_Ucircumflex ()
|
|
3542 "Insert the character 'Ucircumflex'."
|
|
3543 (interactive)
|
|
3544 (insert "Ûumflex;"))
|
|
3545
|
|
3546 (defun hm--html_ediaeresis ()
|
|
3547 "Insert the character 'ediaeresis'."
|
|
3548 (interactive)
|
|
3549 (insert "ë"))
|
|
3550
|
|
3551 (defun hm--html_idiaeresis ()
|
|
3552 "Insert the character 'idiaeresis'."
|
|
3553 (interactive)
|
|
3554 (insert "ï"))
|
|
3555
|
|
3556 (defun hm--html_Ediaeresis ()
|
|
3557 "Insert the character 'Ediaeresis'."
|
|
3558 (interactive)
|
|
3559 (insert "Ë"))
|
|
3560
|
|
3561 (defun hm--html_Idiaeresis ()
|
|
3562 "Insert the character 'Idiaeresis'."
|
|
3563 (interactive)
|
|
3564 (insert "Ï"))
|
|
3565
|
|
3566 (defun hm--html_thorn ()
|
|
3567 "Insert the character 'thorn'."
|
|
3568 (interactive)
|
|
3569 (insert "þ"))
|
|
3570
|
|
3571 (defun hm--html_Thorn ()
|
|
3572 "Insert the character 'Thorn'."
|
|
3573 (interactive)
|
|
3574 (insert "Þ"))
|
|
3575
|
|
3576 (defun hm--html_eth ()
|
|
3577 "Insert the character 'eth'."
|
|
3578 (interactive)
|
|
3579 (insert "ð"))
|
|
3580
|
|
3581 (defun hm--html_Eth ()
|
|
3582 "Insert the character 'Eth'."
|
|
3583 (interactive)
|
|
3584 (insert "Ð"))
|
|
3585
|
|
3586
|
|
3587 ;;;
|
|
3588 ;
|
|
3589 ; smart functions
|
|
3590
|
|
3591 (defvar hm--just-insert-less-than nil
|
|
3592 "Internal variable.")
|
|
3593
|
|
3594 (defun hm--html-smart-less-than ()
|
|
3595 "Insert a '<' or the entity '<' if you execute this command twice."
|
|
3596 (interactive)
|
|
3597 (if (and (eq last-command 'hm--html-smart-less-than)
|
|
3598 hm--just-insert-less-than)
|
|
3599 (progn
|
|
3600 (delete-char -1)
|
|
3601 (html-less-than)
|
|
3602 (setq hm--just-insert-less-than nil))
|
|
3603 (insert ?<)
|
|
3604 (setq hm--just-insert-less-than t)))
|
|
3605
|
|
3606 (defvar hm--just-insert-greater-than nil
|
|
3607 "Internal variable.")
|
|
3608
|
|
3609 (defun hm--html-smart-greater-than ()
|
|
3610 "Insert a '>' or the entity '>' if you execute this command twice."
|
|
3611 (interactive)
|
|
3612 (if (and (eq last-command 'hm--html-smart-greater-than)
|
|
3613 hm--just-insert-greater-than)
|
|
3614 (progn
|
|
3615 (delete-char -1)
|
|
3616 (html-greater-than)
|
|
3617 (setq hm--just-insert-greater-than nil))
|
|
3618 (insert ?>)
|
|
3619 (setq hm--just-insert-greater-than t)))
|
|
3620
|
|
3621
|
|
3622 ;;;
|
|
3623 ; sending the contents of a html buffer to netscape
|
|
3624 ; (Thanks to Adrian Aichner for providing this function)
|
|
3625
|
|
3626 (defun hm--html-send-buffer-to-netscape (buffer
|
|
3627 &optional new-netscape new-window)
|
|
3628 "View html buffer with Netscape.
|
|
3629 This should be changed in the fututure, so that it doesn't need vm."
|
|
3630 (interactive)
|
|
3631 (require 'vm)
|
|
3632 (if new-netscape
|
|
3633 (vm-run-background-command vm-netscape-program buffer-file-name)
|
|
3634 (or (equal 0
|
|
3635 (vm-run-command vm-netscape-program
|
|
3636 "-remote"
|
|
3637 (concat "openURL(file://localhost"
|
|
3638 buffer-file-name
|
|
3639 (if new-window ", new-window" "")
|
|
3640 ")")))
|
|
3641 (hm--html-send-buffer-to-netscape buffer t new-window))))
|
|
3642
|
|
3643
|
|
3644
|
|
3645 ;;;
|
|
3646 ; some other usefull functions
|
|
3647 ;
|
|
3648
|
|
3649 (defun hm--html-remove-numeric-names ()
|
|
3650 "Remove the number in numbered links in the current buffer.
|
|
3651 Eg: the string \"Name=3\". The function asks the user every time whether
|
|
3652 the number should be removed."
|
|
3653 (interactive)
|
|
3654 (save-excursion
|
|
3655 (goto-char (point-min))
|
|
3656 (query-replace-regexp "name=\"?[0-9]+\"?+[ \t]*" "")))
|
|
3657
|
|
3658 ;;This should be extended in the future to use also other viewers.
|
|
3659 (defun hm--html-view-www-package-docu ()
|
|
3660 "View the WWW documentation of the package."
|
|
3661 (interactive)
|
|
3662 (w3-fetch "http://www.tnt.uni-hannover.de:80/data/info/www/tnt/soft/info/www/html-editors/hm--html-menus/overview.html"))
|
|
3663
|
|
3664 ;;;
|
|
3665 ; Bug reporting
|
|
3666 ;
|
|
3667
|
|
3668 (defun hm--html-submit-bug-report ()
|
|
3669 "Submit via mail a bug report on hm--html-menus."
|
|
3670 (interactive)
|
|
3671 (require 'reporter)
|
|
3672 (let ((reporter-prompt-for-summary-p t))
|
|
3673 (reporter-submit-bug-report
|
|
3674 hm--html-menus-package-maintainer
|
|
3675 (concat hm--html-menus-package-name
|
|
3676 " "
|
|
3677 hm--html-menus-package-version)
|
|
3678 (list 'emacs-version
|
|
3679 'major-mode
|
|
3680 'hm--html-automatic-changed-comment
|
|
3681 'hm--html-automatic-created-comment
|
|
3682 'hm--html-automatic-expand-templates
|
|
3683 'hm--html-automatic-new-date
|
|
3684 'hm--html-expert
|
|
3685 'hm--html-favorite-http-server-host-name
|
|
3686 'hm--html-file-path-alist
|
|
3687 'hm--html-ftp-hostname:port-alist
|
|
3688 'hm--html-ftp-hostname:port-default
|
|
3689 'hm--html-ftp-path-alist
|
|
3690 'hm--html-gopher-anchor-alist
|
|
3691 'hm--html-gopher-doctype-alist
|
|
3692 'hm--html-gopher-doctype-default
|
|
3693 'hm--html-gopher-hostname:port-alist
|
|
3694 'hm--html-gopher-hostname:port-default
|
|
3695 'hm--html-html-hostname:port-alist
|
|
3696 'hm--html-html-hostname:port-default
|
|
3697 'hm--html-html-path-alist
|
|
3698 'hm--html-info-hostname:port-alist
|
|
3699 'hm--html-info-hostname:port-default
|
|
3700 'hm--html-info-path-alist
|
|
3701 'hm--html-local-proggate-path-alist
|
|
3702 'hm--html-mail-hostname:port-alist
|
|
3703 'hm--html-mail-hostname:port-default
|
|
3704 'hm--html-mail-path-alist
|
|
3705 'hm--html-marc
|
|
3706 'hm--html-menu-load-hook
|
|
3707 'hm--html-proggate-allowed-file
|
|
3708 'hm--html-proggate-hostname:port-alist
|
|
3709 'hm--html-proggate-hostname:port-default
|
|
3710 'hm--html-server-side-include-command-alist
|
|
3711 'hm--html-server-side-include-command-with-parameter-alist
|
|
3712 'hm--html-signature-file
|
|
3713 'hm--html-template-dir
|
|
3714 'hm--html-url-alist
|
|
3715 'hm--html-user-config-file
|
|
3716 'hm--html-username
|
|
3717 'hm--html-wais-hostname:port-alist
|
|
3718 'hm--html-wais-hostname:port-default
|
|
3719 'hm--html-wais-path-alist
|
|
3720 'hm--html-wais-servername:port-alist
|
|
3721 'hm--html-wais-servername:port-default
|
|
3722 'html-deemphasize-color
|
|
3723 'html-document-previewer
|
|
3724 'html-document-previewer-args
|
|
3725 'html-emphasize-color
|
|
3726 'html-quotify-hrefs-on-find
|
|
3727 'html-region-mode
|
|
3728 'html-sigusr1-signal-value
|
|
3729 'html-use-font-lock
|
|
3730 'html-use-highlighting
|
|
3731 )
|
|
3732 nil
|
|
3733 nil
|
|
3734 "Decribe your Bug: "
|
|
3735 )))
|
|
3736
|
|
3737
|
|
3738 ;;;
|
|
3739 ; hook adding functions
|
|
3740 ;
|
|
3741
|
|
3742 (if (adapt-xemacsp)
|
|
3743 (progn
|
|
3744
|
|
3745 (add-hook 'zmacs-activate-region-hook
|
|
3746 (function (lambda () (html-region-mode t))))
|
|
3747
|
|
3748 (add-hook 'zmacs-deactivate-region-hook
|
|
3749 (function (lambda () (html-region-mode nil))))
|
|
3750
|
|
3751 )
|
|
3752
|
|
3753 (transient-mark-mode t)
|
|
3754
|
|
3755 (add-hook 'activate-mark-hook
|
|
3756 (function (lambda () (html-region-mode t))))
|
|
3757
|
|
3758 (add-hook 'deactivate-mark-hook
|
|
3759 (function (lambda () (html-region-mode nil))))
|
|
3760
|
|
3761 )
|
|
3762
|
|
3763
|
|
3764 (add-hook 'html-mode-hook
|
|
3765 (function
|
|
3766 (lambda ()
|
|
3767 (make-variable-buffer-local 'write-file-hooks)
|
|
3768 (add-hook 'write-file-hooks
|
|
3769 'hm--html-maybe-new-date-and-changed-comment))))
|
|
3770
|
|
3771 ;(add-hook 'zmacs-activate-region-hook 'hm--set-hm--region-active)
|
|
3772 ;
|
|
3773 ;(add-hook 'zmacs-deactivate-region-hook 'hm--unset-hm--region-active)
|
|
3774
|
|
3775
|
|
3776
|
|
3777 ;;;
|
|
3778 ; Environment loading
|
|
3779 ;
|
|
3780
|
|
3781 (defun hm--html-load-config-files ()
|
|
3782 "Load the html configuration files.
|
|
3783 First, the system config file (detemined by the environment variable
|
|
3784 HTML_CONFIG_FILE; normaly hm--html-configuration.el(c)) is loaded and
|
|
3785 after that the user config file (determined by the environment variable
|
|
3786 HTML_USER_CONFIG_FILE; normaly the file ~/.hm--html-configuration.el(c)).
|
|
3787 If no HTML_CONFIG_FILE exists, then the file hm--html-configuration.el(c)
|
|
3788 is searched in one of the lisp load path directories.
|
|
3789 If no HTML_USER_CONFIG_FILE exists, then the variable
|
|
3790 `hm--html-user-config-file' is checked. If this variable is nil or the file
|
|
3791 also doesn't exist, then the file ~/.hm--html-configuration.el(c) is used."
|
|
3792 (interactive)
|
|
3793 ;; at first the system config file
|
|
3794 (if (and (stringp (getenv "HTML_CONFIG_FILE"))
|
|
3795 (file-exists-p
|
|
3796 (expand-file-name
|
|
3797 (getenv "HTML_CONFIG_FILE"))))
|
|
3798 (load-library (expand-file-name (getenv "HTML_CONFIG_FILE")))
|
|
3799 (load-library "hm--html-configuration"))
|
|
3800
|
|
3801 ;; and now the user config file
|
|
3802 (cond ((and (stringp (getenv "HTML_USER_CONFIG_FILE"))
|
|
3803 (file-exists-p
|
|
3804 (expand-file-name
|
|
3805 (getenv "HTML_USER_CONFIG_FILE"))))
|
|
3806 (load-file (expand-file-name (getenv "HTML_USER_CONFIG_FILE"))))
|
|
3807 ((and (boundp 'hm--html-user-config-file)
|
|
3808 (stringp hm--html-user-config-file)
|
|
3809 (file-exists-p (expand-file-name hm--html-user-config-file)))
|
|
3810 (load-file (expand-file-name hm--html-user-config-file)))
|
|
3811 ((file-exists-p (expand-file-name "~/.hm--html-configuration.elc"))
|
|
3812 (load-file (expand-file-name "~/.hm--html-configuration.elc")))
|
|
3813 ((file-exists-p (expand-file-name "~/.hm--html-configuration.el"))
|
|
3814 (load-file (expand-file-name "~/.hm--html-configuration.el")))
|
|
3815 (t
|
|
3816 (message (concat "WARNING: No HTML User Config File ! "
|
|
3817 "Look at hm--html-load-config-files !")))
|
|
3818 )
|
|
3819 )
|
|
3820
|
|
3821
|
|
3822
|
|
3823 ;(hm--html-load-config-files)
|
|
3824
|
|
3825 ;;; Definition of the minor mode html-region-mode
|
|
3826
|
|
3827 (defvar html-region-mode nil
|
|
3828 "*t, if the minor mode html-region-mode is on and nil otherwise.")
|
|
3829
|
|
3830 (make-variable-buffer-local 'html-region-mode)
|
|
3831
|
|
3832 (defvar html-region-mode-map nil "")
|
|
3833
|
|
3834 (hm--html-load-config-files)
|
|
3835
|
|
3836 (if hm--html-use-old-keymap
|
|
3837 (progn
|
|
3838
|
|
3839 ;(setq minor-mode-alist (cons '(html-region-mode " Region") minor-mode-alist))
|
|
3840 (or (assq 'html-region-mode minor-mode-alist)
|
|
3841 (setq minor-mode-alist
|
|
3842 (purecopy
|
|
3843 (append minor-mode-alist
|
|
3844 '((html-region-mode " Region"))))))
|
|
3845
|
|
3846 (defun html-region-mode (on)
|
|
3847 "Turns the minor mode html-region-mode on or off.
|
|
3848 The function turns the html-region-mode on, if ON is t and off otherwise."
|
|
3849 (if (string= mode-name "HTML")
|
|
3850 (if on
|
|
3851 ;; html-region-mode on
|
|
3852 (progn
|
|
3853 (setq html-region-mode t)
|
|
3854 (use-local-map html-region-mode-map))
|
|
3855 ;; html-region-mode off
|
|
3856 (setq html-region-mode nil)
|
|
3857 (use-local-map html-mode-map))))
|
|
3858
|
|
3859 ))
|
|
3860
|
|
3861
|
|
3862
|
|
3863
|
|
3864
|
|
3865 ;;;
|
|
3866 ; Set font lock color
|
|
3867 ; (hm--html-font-lock-color should be defined in hm--html-configuration.el
|
|
3868 ; oder .hm--html-configuration.el)
|
|
3869 ;
|
|
3870 (require 'font-lock)
|
|
3871 ;(load-library "font-lock")
|
|
3872 ;(set-face-foreground 'font-lock-comment-face hm--html-font-lock-color)
|
|
3873
|
|
3874
|
|
3875 (hm--html-generate-help-buffer-faces)
|
|
3876
|
|
3877
|
|
3878
|
|
3879
|
|
3880 ;;;;;;;;
|
|
3881 ;(setq hm--html-hostname-search-string
|
|
3882 ; "[-a-zA-Z0-9]*\\.[-a-zA-Z0-9]*\\.[-a-zA-Z0-9.]*")
|
|
3883 ;
|
|
3884 ;(defun hm--html-get-next-hostname ()
|
|
3885 ; (interactive)
|
|
3886 ; (search-forward-regexp hm--html-hostname-search-string)
|
|
3887 ; (buffer-substring (match-beginning 0) (match-end 0)))
|
|
3888 ;
|