Export: Use custom IDs.

Users can now define custom IDs for use in HTML export.
These IDs are stores as property CUSTOM_ID.  When present, HTML will
prefer using these over automatic targets like "sec-N.M".

lisp/ChangeLog

@@ -1,5 +1,13 @@
 2009-04-16  Carsten Dominik  <carsten.dominik@gmail.com>
 
+	* org-html.el (org-export-as-html): Use custom IDs in the toc.
+
+	* org-exp.el (org-export-preferred-target-alist): New variable.
+	(org-export-define-heading-targets): Find the new CUSTOM_ID
+	property.
+	(org-export-target-internal-links): Target the custom ids when
+	possible.
+
 	* org-latex.el (org-export-latex-preprocess): Better regexp for
 	matching latex macros with arguments.
 

lisp/org-exp.el

@@ -1125,6 +1125,8 @@ translations.  There is currently no way for users to extend this.")
 
 (defvar org-export-target-aliases nil
   "Alist of targets with invisible aliases.")
+(defvar org-export-preferred-target-alist nil
+  "Alist of section id's with preferred aliases.")
 (defvar org-export-code-refs nil
   "Alist of code references and line numbers")
 
@@ -1317,19 +1319,24 @@ The new targets are added to TARGET-ALIST, which is also returned."
   (goto-char (point-min))
   (org-init-section-numbers)
   (let ((re (concat "^" org-outline-regexp
-		    "\\| [ \t]*:ID:[ \t]*\\([^ \t\r\n]+\\)"))
-	level target last-section-target a)
+		    "\\| [ \t]*:\\(ID\\|CUSTOM_ID\\):[ \t]*\\([^ \t\r\n]+\\)"))
+	level target last-section-target a id)
     (while (re-search-forward re nil t)
-      (if (match-end 1)
+      (if (match-end 2)
 	  (progn
-	    (push (cons (org-match-string-no-properties 1)
-			target) target-alist)
+	    (setq id (org-match-string-no-properties 2))
+	    (push (cons id target) target-alist)
 	    (setq a (or (assoc last-section-target org-export-target-aliases)
 			(progn
 			  (push (list last-section-target)
 				org-export-target-aliases)
 			  (car org-export-target-aliases))))
-	    (push (caar target-alist) (cdr a)))
+	    (push (caar target-alist) (cdr a))
+	    (when (equal (match-string 1) "CUSTOM_ID")
+	      (if (not (assoc last-section-target
+			      org-export-preferred-target-alist))
+		  (push (cons last-section-target id)
+			org-export-preferred-target-alist))))
 	(setq level (org-reduced-level
 		     (save-excursion (goto-char (point-at-bol))
 				     (org-outline-level))))
@@ -1386,7 +1393,10 @@ the current file."
 	      ((= (string-to-char link) ?#)
 	       ;; user wants exactly this link
 	       link)
-	      ((cdr (assoc slink target-alist)))
+	      ((cdr (assoc slink target-alist))
+	       (or (cdr (assoc (assoc slink target-alist)
+			       org-export-preferred-target-alist))
+		   (cdr (assoc slink target-alist))))
 	      ((and (string-match "^id:" link)
 		    (cdr (assoc (substring link 3) target-alist))))
 	      ((string-match "^(\\(.*\\))$" link)

lisp/org-html.el

@@ -594,7 +594,7 @@ PUB-DIR is set, use this as the publishing directory."
 	 rpl path attr desc descp desc1 desc2 link
 	 snumber fnc item-tag
 	 footnotes footref-seen
-	 id-file
+	 id-file href
 	 )
 
     (let ((inhibit-read-only t))
@@ -733,12 +733,14 @@ lang=\"%s\" xml:lang=\"%s\">
 					      t t line)))
 				(while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt)
 				  (setq txt (replace-match "" t t txt)))
+				(setq href (format "sec-%s" snumber))
+				(setq href (or (cdr (assoc href org-export-preferred-target-alist)) href))
 				(push
 				 (format
 				  (if todo
-				      "</li>\n<li><a href=\"#sec-%s\"><span class=\"todo\">%s</span></a>"
-				    "</li>\n<li><a href=\"#sec-%s\">%s</a>")
-				  snumber txt) thetoc)
+				      "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
+				    "</li>\n<li><a href=\"#%s\">%s</a>")
+				  href txt) thetoc)
 
 				(setq org-last-level level))
 			    )))
@@ -1811,15 +1813,19 @@ If there are links in the string, don't modify these."
 When TITLE is nil, just close all open levels."
   (org-close-par-maybe)
   (let* ((target (and title (org-get-text-property-any 0 'target title)))
-	 (extra-targets
+	 (extra-targets (assoc target org-export-target-aliases))
+	 (preferred (cdr (assoc target org-export-preferred-target-alist)))
+	 (remove (or preferred target))
+	 (l org-level-max)
+	 snumber href suffix)
+    (setq extra-targets (remove remove extra-targets))
+    (setq extra-targets
 	  (mapconcat (lambda (x)
 		       (if (org-uuidgen-p x) (setq x (concat "ID-" x)))
 		       (format "<a name=\"%s\" id=\"%s\"></a>"
 			       x x))
-		     (cdr (assoc target org-export-target-aliases))
+		     extra-targets
 		     ""))
-	 (l org-level-max)
-	 snumber)
     (while (>= l level)
       (if (aref org-levels-open (1- l))
 	  (progn
@@ -1868,9 +1874,12 @@ When TITLE is nil, just close all open levels."
 				 level snumber)
 			 " " title)))
 	(unless (= head-count 1) (insert "\n</div>\n"))
-	(insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d\">\n<h%d id=\"sec-%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n"
-			snumber level level snumber extra-targets
-			title level level snumber))
+	(setq href (cdr (assoc (concat "sec-" snumber) org-export-preferred-target-alist)))
+	(setq suffix (or href (concat "sec-" snumber)))
+	(insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n"
+			suffix level level href
+			extra-targets
+			title level level suffix))
 	(org-open-par)))))
 
 (defun org-export-html-get-tag-class-name (tag)