From mboxrd@z Thu Jan 1 00:00:00 1970 From: Bastien Guerry Subject: =?UTF-8?B?W0FjY2VwdGVkXSBFeHBvcnQgaXNzdWUgb2YgVVJMIHdoZW4gdGhl?= =?UTF-8?B?IHRleHQgYmVnaW5zIHdpdGggYSBkYXRl4oCP?= Date: Mon, 31 Jan 2011 19:29:43 +0100 (CET) Message-ID: <20110131182943.9158D87AB@myhost.localdomain> References: <87sjwae2ar.wl%dmaus@ictsoc.de> Mime-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit Return-path: Received: from [140.186.70.92] (port=56522 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PjyVV-0000TB-VH for emacs-orgmode@gnu.org; Mon, 31 Jan 2011 13:29:50 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PjyVT-0000db-KS for emacs-orgmode@gnu.org; Mon, 31 Jan 2011 13:29:45 -0500 Received: from mail-ww0-f49.google.com ([74.125.82.49]:48389) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PjyVT-0000dQ-7b for emacs-orgmode@gnu.org; Mon, 31 Jan 2011 13:29:43 -0500 Received: by wwb17 with SMTP id 17so6244019wwb.30 for ; Mon, 31 Jan 2011 10:29:42 -0800 (PST) List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.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 > X-Patchwork-Id: 565 > Message-Id: <87sjwae2ar.wl%dmaus@ictsoc.de> > To: Bastien > Cc: David Maus , > Vincent =?UTF-8?B?QmVsYcOvY2hl?= , > Org mode > > At Mon, 17 Jan 2011 18:55:54 +0100, > Bastien wrote: > > > > David Maus 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 > 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) > ""))))) > > +(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 "") > + '(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 "<" type ":" > + (save-match-data (org-link-unescape path)) > + ">")))) > + (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 "") > - '(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 "<" type ":" > - (save-match-data (org-link-unescape path)) > - ">")))) > - (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)) > >