diff lisp/hm--html-menus/hm--html.el @ 116:9f59509498e1 r20-1b10

Import from CVS: tag r20-1b10
author cvs
date Mon, 13 Aug 2007 09:23:06 +0200
parents a145efe76779
children 1856695b1fa9
line wrap: on
line diff
--- a/lisp/hm--html-menus/hm--html.el	Mon Aug 13 09:21:56 2007 +0200
+++ b/lisp/hm--html-menus/hm--html.el	Mon Aug 13 09:23:06 2007 +0200
@@ -1,4 +1,4 @@
-;;; $Id: hm--html.el,v 1.4 1997/02/27 06:08:10 steve Exp $
+;;; $Id: hm--html.el,v 1.5 1997/03/28 02:28:42 steve Exp $
 ;;;
 ;;; Copyright (C) 1993 - 1997  Heiko Muenkel
 ;;; email: muenkel@tnt.uni-hannover.de
@@ -153,7 +153,7 @@
   "Adds the HTML tag for a basefont."
   (interactive (list (hm--html-read-font-size t)))
   (hm--html-add-tags 'hm--html-insert-start-tag 
-		     (concate "<BASEFONT SIZE=" size ">")))
+		     (concat "<BASEFONT SIZE=" size ">")))
 
 (defun hm--html-add-line-break ()
   "Adds the HTML tag for a line break."
@@ -207,13 +207,14 @@
 	(point)
       (goto-char (point-min))
       (if (re-search-forward
-	   (concat "\\(<title\\)\\|\\(<head\\)\\|\\(<html\\)\\|"
-		   "\\(<isindex\\)\\|\\(<base\\)\\|\\(<link\\)\\|"
-		   "\\(<meta")
+	   (concat ;"\\(<title\\)\\|\\(<head\\)\\|\\(<html\\)\\|"
+	    "\\(<title\\)\\|"
+	    "\\(<isindex\\)\\|\\(<base\\)\\|\\(<link\\)\\|"
+	    "\\(<meta\\)")
 	   end-point
 	   t)
 	  (beginning-of-line)
-	point))))
+	end-point))))
 
 (defun hm--html-add-isindex (prompt)
   "Inserts the isindex tag. PROMPT is the value of the prompt attribute."
@@ -226,17 +227,18 @@
       (setq head-end-point (when (re-search-forward
 				  "\\(</head\\)\\|\\(<body\\)\\|\\(</html\\)")
 			     (beginning-of-line)
-			     (point))))
-    (cond ((re-search-forward "<isindex[^>]*>" head-end-point t)
-	   (delete-region (match-beginning 0) (match-end 0)))
-	  (t (goto-char point)
-	     (hm--html-search-place-for-element-in-head head-end-point)))
-    (hm--html-add-tags 'hm--html-insert-start-tag
-		       (concat "<ISINDEX "
-			       (if (and prompt
-					(not (string= prompt "")))
-				   (concat " PROMPT=\"" prompt "\">")
-				 ">")))))
+			     (point)))
+      (goto-char (point-min))
+      (cond ((re-search-forward "<isindex[^>]*>" head-end-point t)
+	     (delete-region (match-beginning 0) (match-end 0)))
+	    (t (goto-char point)
+	       (hm--html-search-place-for-element-in-head head-end-point)))
+      (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
+			 (concat "<ISINDEX "
+				 (if (and prompt
+					  (not (string= prompt "")))
+				     (concat " PROMPT=\"" prompt "\">")
+				   ">"))))))
 				   
 (defun hm--html-add-base (href)
   "Inserts the base tag. HREF is the value of the href attribute."
@@ -253,17 +255,18 @@
       (setq head-end-point (when (re-search-forward
 				  "\\(</head\\)\\|\\(<body\\)\\|\\(</html\\)")
 			     (beginning-of-line)
-			     (point))))
-    (cond ((re-search-forward "<base[^>]*>" head-end-point t)
-	   (delete-region (match-beginning 0) (match-end 0)))
-	  (t (goto-char point)
-	     (hm--html-search-place-for-element-in-head head-end-point)))
-    (hm--html-add-tags 'hm--html-insert-start-tag
-		       (concat "<BASE "
-			       (if (and href
-					(not (string= href "")))
-				   (concat " HREF=\"" href "\">")
-				 ">")))))
+			     (point)))
+      (goto-char (point-min))
+      (cond ((re-search-forward "<base[^>]*>" head-end-point t)
+	     (delete-region (match-beginning 0) (match-end 0)))
+	    (t (goto-char point)
+	       (hm--html-search-place-for-element-in-head head-end-point)))
+      (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
+			 (concat "<BASE "
+				 (if (and href
+					  (not (string= href "")))
+				     (concat " HREF=\"" href "\">")
+				   ">"))))))
 
 (defun hm--html-add-meta (name content &optional name-instead-of-http-equiv)
   "Inserts the meta tag."
@@ -280,7 +283,7 @@
 			     (point)))
       (goto-char point)
       (hm--html-search-place-for-element-in-head head-end-point)
-      (hm--html-add-tags 'hm--html-insert-start-tag
+      (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
 			 (concat "<META "
 				 (if name-instead-of-http-equiv
 				     "NAME=\""
@@ -442,6 +445,10 @@
 			     "\nCOORDS=\"" coords "\""
 			     ">")))
 
+
+(when (adapt-emacs19p)
+      (defvar :ask ':ask))
+
 (defvar hm--html-use-image-as-map ':ask
   "Internal variable of `hm--html-add-image'.
 nil => insert the image element without an usemap attribute.
@@ -549,43 +556,6 @@
 			     "\">")))
 		     
 
-(defun hm--html-add-server-side-include-file (file)
-  "This function adds a server side include file directive in the buffer.
-The directive is only supported by the NCSA http daemon."
-  (interactive "FInclude File: ")
-  (let ((start (point)))
-    (if (string= file "")
-	(error "ERROR: No filename specified !")
-      (insert "<INC SRV \"" file "\">"))))
-  
-
-(defun hm--html-add-server-side-include-command-with-isindex-parameter 
-  (command)
-  "This function adds a server side include command directive in the buffer.
-The include command uses the \"isindex\"- parameter for the specified command."
-  (interactive (list 
-		(completing-read "Include Command: "
-				 hm--html-server-side-include-command-alist)))
-  (hm--html-add-server-side-include-command command t))
-
-
-(defun hm--html-add-server-side-include-command (command &optional srvurl)
-  "This function adds a server side include command directive in the buffer.
-The directive is only supported by the NCSA http daemon.
-If SRVURL is t, then the attribute srvurl instead of srv is used for the 
-include command. With srvurl, the include command uses the \"isindex\"-
-parameter for the specified command."
-  (interactive (list 
-		(completing-read "Include Command: "
-				 hm--html-server-side-include-command-alist)))
-  (let ((start (point))
-	(attribute (if srvurl "SRVURL" "SRV")))
-    (if (string= command "")
-	(error "ERROR: No command specified !")
-      (if (= ?| (string-to-char command))
-	  (insert "<INC " attribute" \"" command "\">")
-	(insert "<INC " attribute " \"|" command "\">")))))
-
 
 ;;; Functions, which adds tags of the form <starttag> ... </endtag>
 
@@ -865,7 +835,7 @@
 		     "</DIV>"))
 
 
-(defun hm--html-add-document-division-to-region ()
+(defun hm--html-add-document-division-to-region (alignment)
   "Adds the HTML tags for document division to the region."
   (interactive (list (hm--html-read-alignment "Alignment of the division: ")))
   (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
@@ -1071,7 +1041,7 @@
 		     "</FONT>"))
 
 
-(defun hm--html-add-font-to-region ()
+(defun hm--html-add-font-to-region (size color)
   "Adds the HTML tags for Font to the region."
   (interactive (list (hm--html-read-font-size)
 		     (hm--html-read-font-color)))
@@ -1975,58 +1945,58 @@
 value and an example string. The ANCHOR-PARAMETER-LIST has as an additional
 element an anchor seperator string. All these elements are used to read and
 construct the link."
-  (let ((point nil))
-    (save-window-excursion
-      (let ((html-buffer (current-buffer))
-	    (html-help-buffer (hm--html-generate-add-link-help-buffer
-			       scheme-parameter-list
-			       host-name:port-parameter-list
-			       servername:port-parameter-list
-			       path+file-parameter-list
-			       anchor-parameter-list))
-	    (scheme (hm--html-completing-read scheme-parameter-list))
-	    (hostname:port (hm--html-completing-read 
-			    host-name:port-parameter-list))
-	    (servername:port (hm--html-completing-read 
-			      servername:port-parameter-list))
-	    (path+file (hm--html-read-filename path+file-parameter-list))
-	    (anchor (hm--html-completing-read anchor-parameter-list))
-;	    (hrefname (setq html-link-counter (1+ html-link-counter)))
-	    (anchor-seperator 
-	     (hm--html-get-anchor-seperator-from-parameter-list
-	      anchor-parameter-list)))
-	(if (not (string= scheme ""))
-	    (if (string= hostname:port "")
-		(setq scheme (concat scheme ":"))
-	      (setq scheme (concat scheme "://"))))
-	(if (and (not (string= hostname:port ""))
-		 (not (string= servername:port ""))
-		 (not (string= (substring servername:port 0 1) "/")))
-	    (setq servername:port (concat "/" servername:port)))
-	(if (and (not (string= path+file ""))
-		 (not (string= "/" (substring path+file 0 1))))
-	    (setq path+file (concat "/" path+file)))
-	(if (not (string= anchor ""))
-	    (setq anchor (concat anchor-seperator anchor)))
-	(kill-buffer  html-help-buffer)
-	(pop-to-buffer html-buffer)
-	(eval (list function-add-tags 
-		    ''hm--html-insert-start-tag
-		    (concat "<A"
+;  (let ((point nil))
+  (save-window-excursion
+    (let ((html-buffer (current-buffer))
+	  (html-help-buffer (hm--html-generate-add-link-help-buffer
+			     scheme-parameter-list
+			     host-name:port-parameter-list
+			     servername:port-parameter-list
+			     path+file-parameter-list
+			     anchor-parameter-list))
+	  (scheme (hm--html-completing-read scheme-parameter-list))
+	  (hostname:port (hm--html-completing-read 
+			  host-name:port-parameter-list))
+	  (servername:port (hm--html-completing-read 
+			    servername:port-parameter-list))
+	  (path+file (hm--html-read-filename path+file-parameter-list))
+	  (anchor (hm--html-completing-read anchor-parameter-list))
+;	  (hrefname (setq html-link-counter (1+ html-link-counter)))
+	  (anchor-seperator 
+	   (hm--html-get-anchor-seperator-from-parameter-list
+	    anchor-parameter-list)))
+      (if (not (string= scheme ""))
+	  (if (string= hostname:port "")
+	      (setq scheme (concat scheme ":"))
+	    (setq scheme (concat scheme "://"))))
+      (if (and (not (string= hostname:port ""))
+	       (not (string= servername:port ""))
+	       (not (string= (substring servername:port 0 1) "/")))
+	  (setq servername:port (concat "/" servername:port)))
+      (if (and (not (string= path+file ""))
+	       (not (string= "/" (substring path+file 0 1))))
+	  (setq path+file (concat "/" path+file)))
+      (if (not (string= anchor ""))
+	  (setq anchor (concat anchor-seperator anchor)))
+      (kill-buffer  html-help-buffer)
+      (pop-to-buffer html-buffer)
+      (eval (list function-add-tags 
+		  ''hm--html-insert-start-tag
+		  (concat "<A"
 ;		            "<A Name="
 ;			    hrefname
-			    " HREF=\""
-			    scheme
-			    hostname:port
-			    servername:port
-			    path+file
-			    anchor
-			    "\">")
-		    ''hm--html-insert-end-tag
-		    "</A>")))
-      (setq point (point))))
-  (goto-char (point)))
-
+			  " HREF=\""
+			  scheme
+			  hostname:port
+			  servername:port
+			  path+file
+			  anchor
+			  "\">")
+		  ''hm--html-insert-end-tag
+		  "</A>")))
+;    (setq point (point))))
+; (goto-char (point)))
+    ))
 
 (defun hm--html-add-info-link-1 (function-add-tags)
   "Internal function. Adds the HTML tags for a link on a GNU Info file."
@@ -2503,7 +2473,7 @@
 (defun hm--html-make-newsgroup-alist ()
   "Makes a hm--html-make-newsgroup-alist from a .newsrc.el file.
 The function looks at the environment variable NNTPSERVER.
-If this variable exists, it trys to open the file with the Name
+If this variable exists, it tries to open the file with the Name
 ~/$NNTPSERVER.el. If this file exists, the alist of the file is
 returned as the newsgroup-alist. If the file doesn't exist, it
 tries to use the file ~/$NNTPSERVER to make the alist. The function
@@ -2623,13 +2593,13 @@
 (defun hm--html-add-mail-box-link ()
   "Adds the HTML tags for a link to a mail box."
   (interactive)
-  (hm--html-add-mail-link-1 'hm--html-add-tags))
+  (hm--html-add-mail-box-link-1 'hm--html-add-tags))
 
 
 (defun hm--html-add-mail-box-link-to-region ()
   "Adds the HTML tags for a link to a mail box to the region."
   (interactive)
-  (hm--html-add-mail-link-1 'hm--html-add-tags-to-region))
+  (hm--html-add-mail-box-link-1 'hm--html-add-tags-to-region))
 
 
 (defun hm--html-add-mailto-link-1 (function-add-tags)
@@ -2801,25 +2771,25 @@
       (if (not (search-forward "</title>" end-of-head t))
 	  (if (not noerror)
 	      (error "ERROR: Please insert a title in the document !"))
-	(let ((end-of-title-position (point)))
-	  (if (search-forward "<!-- Created by: " end-of-head t)
-	      (if (yes-or-no-p 
-		   "Replace the old comment \"<!-- Created by: \" ")
-		  (progn
-		    (goto-char (match-beginning 0))
-		    (kill-line)
-		    (hm--html-add-comment)
-		    (insert "Created by: " 
-			    (or hm--html-username (user-full-name))
-			    ", "
-			    (hm--date))))
-	    (newline)
-	    (hm--html-add-comment)
-	    (insert "Created by: " 
-		    (or hm--html-username (user-full-name))
-		    ", "
-		    (hm--date)
-		    )))))))
+;	(let ((end-of-title-position (point)))
+	(if (search-forward "<!-- Created by: " end-of-head t)
+	    (if (yes-or-no-p 
+		 "Replace the old comment \"<!-- Created by: \" ")
+		(progn
+		  (goto-char (match-beginning 0))
+		  (kill-line)
+		  (hm--html-add-comment)
+		  (insert "Created by: " 
+			  (or hm--html-username (user-full-name))
+			  ", "
+			  (hm--date))))
+	  (newline)
+	  (hm--html-add-comment)
+	  (insert "Created by: " 
+		  (or hm--html-username (user-full-name))
+		  ", "
+		  (hm--date)
+		  ))))))
 
 
 (defun hm--html-insert-changed-comment-1 (newline username)