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

[Bastien Guerry <bzg@altern.org>]

Patch 565 (http://patchwork.newartisans.com/patch/565/) is now "Accepted".

Maintainer comment: none

This relates to the following submission:

http://mid.gmane.org/%3C87sjwae2ar.wl%25dmaus%40ictsoc.de%3E

Here is the original message containing the patch:

> Content-Type: text/plain; charset="utf-8"
> MIME-Version: 1.0
> Content-Transfer-Encoding: 7bit
> Subject: [Orgmode] Export issue of URL when the text begins with a
> 	=?UTF-8?B?ZGF0ZeKAjw==?=
> Date: Sun, 30 Jan 2011 22:20:28 -0000
> From: David Maus <dmaus@ictsoc.de>
> X-Patchwork-Id: 565
> Message-Id: <87sjwae2ar.wl%dmaus@ictsoc.de>
> To: Bastien <bastien.guerry@wikimedia.fr>
> Cc: David Maus <dmaus@ictsoc.de>,
> 	Vincent =?UTF-8?B?QmVsYcOvY2hl?= <vincent.b.1@hotmail.fr>,
> 	Org mode <emacs-orgmode@gnu.org>
> 
> 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
> 
> ---
> OpenPGP... 0x99ADB83B5A4478E6
> Jabber.... dmjena@jabber.org
> Email..... dmaus@ictsoc.de
> >From ea1c1e8528af0490c03133a09575e72fa4d0f352 Mon Sep 17 00:00:00 2001
> From: David Maus <dmaus@ictsoc.de>
> Date: Sun, 30 Jan 2011 18:12:06 +0100
> Subject: [PATCH] Factor out link Handling during export
> 
> * org-html.el (org-html-handle-links): New function. Factor out link Handling
> during export.
> (org-export-as-html): Use new function.
> 
> Putting the entire logic of link handling in a separate function makes
> it easier to test the link creation during html export and maybe
> refactor the function in the future.  The body of the function is a
> 1:1 copy of the original code in `org-export-as-html', symbols which
> were used by the link handling exclusively are removed from
> `org-export-as-html'.
> ---
>  lisp/org-html.el |  332 ++++++++++++++++++++++++++++--------------------------
>  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))
>  
>