Export issue of URL when the text begins with a date‏

At Mon, 17 Jan 2011 18:55:54 +0100,
Bastien wrote:
>
> David Maus <dmaus@ictsoc.de> writes:
>
> >> It seems that such a non-regression test base and script do not
> >> exist. However that would be good to have in order to check that any
> >> correction does not break anything.
> >
> > That's exactly what the testing framework[1] could and should do.
> > I've just not figured out how to best write tests for entire export
> > operations.  Thinking of it: We could create an input file dedicated
> > to test link exporting, put in different kinds of links, export and
> > then use regexps to check if the links have been exported fine.
>
> I've just added testing/links.org to the testing framework.
>
> Vincent, feel free to suggest any addition to testing/ so that we can
> enrich our test-base with various examples!  Being able to reproduce
> errors on those files will help people feel confident the error does
> not come from their configuration.

Attached patch factors out the link handling part of
`org-export-as-html' in a separat function which takes the processed
line and the exporting options as arguments and returns the possibly
modified line.  Having the link handling in a separate function makes
it way easier to test this specific behaviour of export.

Best,
  -- David

1 files changed, 171 insertions, 161 deletions

diff --git a/lisp/org-html.el b/lisp/org-html.el
index 9a5d225..2216852 100644
--- a/lisp/org-html.el
+++ b/lisp/org-html.el
@@ -795,6 +795,173 @@ MAY-INLINE-P allows inlining it as an image."
 	       (org-export-html-format-desc desc)
 	       "</a>")))))
 
+(defun org-html-handle-links (line opt-plist)
+  "Return LINE with markup of Org mode links.
+OPT-PLIST is the export options list."
+  (let ((start 0)
+	(current-dir (if buffer-file-name
+			  (file-name-directory buffer-file-name)
+			default-directory))
+	(link-validate (plist-get opt-plist :link-validation-function))
+	type id-file fnc
+	rpl path attr desc descp desc1 desc2 link)
+    (while (string-match org-bracket-link-analytic-regexp++ line start)
+      (setq start (match-beginning 0))
+      (setq path (save-match-data (org-link-unescape
+				   (match-string 3 line))))
+      (setq type (cond
+		  ((match-end 2) (match-string 2 line))
+		  ((save-match-data
+		     (or (file-name-absolute-p path)
+			 (string-match "^\\.\\.?/" path)))
+		   "file")
+		  (t "internal")))
+      (setq path (org-extract-attributes (org-link-unescape path)))
+      (setq attr (get-text-property 0 'org-attributes path))
+      (setq desc1 (if (match-end 5) (match-string 5 line))
+	    desc2 (if (match-end 2) (concat type ":" path) path)
+	    descp (and desc1 (not (equal desc1 desc2)))
+	    desc (or desc1 desc2))
+      ;; Make an image out of the description if that is so wanted
+      (when (and descp (org-file-image-p
+			desc org-export-html-inline-image-extensions))
+	(save-match-data
+	  (if (string-match "^file:" desc)
+	      (setq desc (substring desc (match-end 0)))))
+	(setq desc (org-add-props
+		       (concat "<img src=\"" desc "\"/>")
+		       '(org-protected t))))
+      (cond
+       ((equal type "internal")
+	(let
+	    ((frag-0
+	      (if (= (string-to-char path) ?#)
+		  (substring path 1)
+		path)))
+	  (setq rpl
+		(org-html-make-link
+		 opt-plist
+		 ""
+		 ""
+		 (org-solidify-link-text
+		  (save-match-data (org-link-unescape frag-0))
+		  nil)
+		 desc attr nil))))
+       ((and (equal type "id")
+	     (setq id-file (org-id-find-id-file path)))
+	;; This is an id: link to another file (if it was the same file,
+	;; it would have become an internal link...)
+	(save-match-data
+	  (setq id-file (file-relative-name
+			 id-file
+			 (file-name-directory org-current-export-file)))
+	  (setq rpl
+		(org-html-make-link opt-plist
+				    "file" id-file
+				    (concat (if (org-uuidgen-p path) "ID-") path)
+				    desc
+				    attr
+				    nil))))
+       ((member type '("http" "https"))
+	;; standard URL, can inline as image
+	(setq rpl
+	      (org-html-make-link opt-plist
+				  type path nil
+				  desc
+				  attr
+				  (org-html-should-inline-p path descp))))
+       ((member type '("ftp" "mailto" "news"))
+	;; standard URL, can't inline as image
+	(setq rpl
+	      (org-html-make-link opt-plist
+				  type path nil
+				  desc
+				  attr
+				  nil)))
+
+       ((string= type "coderef")
+	(let*
+	    ((coderef-str (format "coderef-%s" path))
+	     (attr-1
+	      (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\""
+		      coderef-str coderef-str)))
+	  (setq rpl
+		(org-html-make-link opt-plist
+				    type "" coderef-str
+				    (format
+				     (org-export-get-coderef-format
+				      path
+				      (and descp desc))
+				     (cdr (assoc path org-export-code-refs)))
+				    attr-1
+				    nil))))
+
+       ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
+	;; The link protocol has a function for format the link
+	(setq rpl
+	      (save-match-data
+		(funcall fnc (org-link-unescape path) desc1 'html))))
+
+       ((string= type "file")
+	;; FILE link
+	(save-match-data
+	  (let*
+	      ((components
+		(if
+		    (string-match "::\\(.*\\)" path)
+		    (list
+		     (replace-match "" t nil path)
+		     (match-string 1 path))
+		  (list path nil)))
+
+	       ;;The proper path, without a fragment
+	       (path-1
+		(first components))
+
+	       ;;The raw fragment
+	       (fragment-0
+		(second components))
+
+	       ;;Check the fragment.  If it can't be used as
+	       ;;target fragment we'll pass nil instead.
+	       (fragment-1
+		(if
+		    (and fragment-0
+			 (not (string-match "^[0-9]*$" fragment-0))
+			 (not (string-match "^\\*" fragment-0))
+			 (not (string-match "^/.*/$" fragment-0)))
+		    (org-solidify-link-text
+		     (org-link-unescape fragment-0))
+		  nil))
+	       (desc-2
+		;;Description minus "file:" and ".org"
+		(if (string-match "^file:" desc)
+		    (let
+			((desc-1 (replace-match "" t t desc)))
+		      (if (string-match "\\.org$" desc-1)
+			  (replace-match "" t t desc-1)
+			desc-1))
+		  desc)))
+
+	    (setq rpl
+		  (if
+		      (and
+		       (functionp link-validate)
+		       (not (funcall link-validate path-1 current-dir)))
+		      desc
+		    (org-html-make-link opt-plist
+					"file" path-1 fragment-1 desc-2 attr
+					(org-html-should-inline-p path-1 descp)))))))
+
+       (t
+	;; just publish the path, as default
+	(setq rpl (concat "<i>&lt;" type ":"
+			  (save-match-data (org-link-unescape path))
+			  "&gt;</i>"))))
+      (setq line (replace-match rpl t t line)
+	    start (+ start (length rpl))))
+    line))
+
 ;;; org-export-as-html
 ;;;###autoload
 (defun org-export-as-html (arg &optional hidden ext-plist
@@ -844,7 +1011,6 @@ PUB-DIR is set, use this as the publishing directory."
 			(if (plist-get opt-plist :style-include-scripts)
 			    org-export-html-scripts)))
 	 (html-extension (plist-get opt-plist :html-extension))
-	 (link-validate (plist-get opt-plist :link-validation-function))
 	 valid thetoc have-headings first-heading-pos
 	 (odd org-odd-levels-only)
 	 (region-p (org-region-active-p))
@@ -980,13 +1146,12 @@ PUB-DIR is set, use this as the publishing directory."
 	       org-export-html-mathjax-options
 	       (or (plist-get opt-plist :mathjax) ""))
 	    ""))
-	 table-open type
+	 table-open
 	 table-buffer table-orig-buffer
 	 ind item-type starter
-	 rpl path attr desc descp desc1 desc2 link
-	 snumber fnc item-tag item-number
+	 snumber item-tag item-number
 	 footnotes footref-seen
-	 id-file href
+	 href
 	 )
 
     (let ((inhibit-read-only t))
@@ -1315,162 +1480,7 @@ lang=\"%s\" xml:lang=\"%s\">
 	      (setq line (org-html-expand line)))
 
 	  ;; Format the links
-	  (setq start 0)
-	  (while (string-match org-bracket-link-analytic-regexp++ line start)
-	    (setq start (match-beginning 0))
-	    (setq path (save-match-data (org-link-unescape
-					 (match-string 3 line))))
-	    (setq type (cond
-			((match-end 2) (match-string 2 line))
-			((save-match-data
-			   (or (file-name-absolute-p path)
-			       (string-match "^\\.\\.?/" path)))
-			 "file")
-			(t "internal")))
-	    (setq path (org-extract-attributes (org-link-unescape path)))
-	    (setq attr (get-text-property 0 'org-attributes path))
-	    (setq desc1 (if (match-end 5) (match-string 5 line))
-		  desc2 (if (match-end 2) (concat type ":" path) path)
-		  descp (and desc1 (not (equal desc1 desc2)))
-		  desc (or desc1 desc2))
-	    ;; Make an image out of the description if that is so wanted
-	    (when (and descp (org-file-image-p
-			      desc org-export-html-inline-image-extensions))
-	      (save-match-data
-		(if (string-match "^file:" desc)
-		    (setq desc (substring desc (match-end 0)))))
-	      (setq desc (org-add-props
-			     (concat "<img src=\"" desc "\"/>")
-			     '(org-protected t))))
-	    (cond
-	     ((equal type "internal")
-	      (let
-		  ((frag-0
-		    (if (= (string-to-char path) ?#)
-			(substring path 1)
-		      path)))
-		(setq rpl
-		      (org-html-make-link
-		       opt-plist
-		       ""
-		       ""
-		       (org-solidify-link-text
-			(save-match-data (org-link-unescape frag-0))
-			nil)
-		       desc attr nil))))
-	     ((and (equal type "id")
-		   (setq id-file (org-id-find-id-file path)))
-	      ;; This is an id: link to another file (if it was the same file,
-	      ;; it would have become an internal link...)
-	      (save-match-data
-		(setq id-file (file-relative-name
-			       id-file
-			       (file-name-directory org-current-export-file)))
-		(setq rpl
-		      (org-html-make-link opt-plist
-					  "file" id-file
-					  (concat (if (org-uuidgen-p path) "ID-") path)
-					  desc
-					  attr
-					  nil))))
-	     ((member type '("http" "https"))
-	      ;; standard URL, can inline as image
-	      (setq rpl
-		    (org-html-make-link opt-plist
-					type path nil
-					desc
-					attr
-					(org-html-should-inline-p path descp))))
-	     ((member type '("ftp" "mailto" "news"))
-	      ;; standard URL, can't inline as image
-	      (setq rpl
-		    (org-html-make-link opt-plist
-					type path nil
-					desc
-					attr
-					nil)))
-
-	     ((string= type "coderef")
-	      (let*
-		  ((coderef-str (format "coderef-%s" path))
-		   (attr-1
-		    (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\""
-			    coderef-str coderef-str)))
-		(setq rpl
-		      (org-html-make-link opt-plist
-					  type "" coderef-str
-					  (format
-					   (org-export-get-coderef-format
-					    path
-					    (and descp desc))
-					   (cdr (assoc path org-export-code-refs)))
-					  attr-1
-					  nil))))
-
-	     ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
-	      ;; The link protocol has a function for format the link
-	      (setq rpl
-		    (save-match-data
-		      (funcall fnc (org-link-unescape path) desc1 'html))))
-
-	     ((string= type "file")
-	      ;; FILE link
-	      (save-match-data
-		(let*
-		    ((components
-		      (if
-			  (string-match "::\\(.*\\)" path)
-			  (list
-			   (replace-match "" t nil path)
-			   (match-string 1 path))
-			(list path nil)))
-
-		     ;;The proper path, without a fragment
-		     (path-1
-		      (first components))
-
-		     ;;The raw fragment
-		     (fragment-0
-		      (second components))
-
-		     ;;Check the fragment.  If it can't be used as
-		     ;;target fragment we'll pass nil instead.
-		     (fragment-1
-		      (if
-			  (and fragment-0
-			       (not (string-match "^[0-9]*$" fragment-0))
-			       (not (string-match "^\\*" fragment-0))
-			       (not (string-match "^/.*/$" fragment-0)))
-			  (org-solidify-link-text
-			   (org-link-unescape fragment-0))
-			nil))
-		     (desc-2
-		      ;;Description minus "file:" and ".org"
-		      (if (string-match "^file:" desc)
-			  (let
-			      ((desc-1 (replace-match "" t t desc)))
-			    (if (string-match "\\.org$" desc-1)
-				(replace-match "" t t desc-1)
-			      desc-1))
-			desc)))
-
-		  (setq rpl
-			(if
-			    (and
-			     (functionp link-validate)
-			     (not (funcall link-validate path-1 current-dir)))
-			    desc
-			  (org-html-make-link opt-plist
-					      "file" path-1 fragment-1 desc-2 attr
-					      (org-html-should-inline-p path-1 descp)))))))
-
-	     (t
-	      ;; just publish the path, as default
-	      (setq rpl (concat "<i>&lt;" type ":"
-				(save-match-data (org-link-unescape path))
-				"&gt;</i>"))))
-	    (setq line (replace-match rpl t t line)
-		  start (+ start (length rpl))))
+	  (setq line (org-html-handle-links line opt-plist))
 
 	  (setq line (org-html-handle-time-stamps line))