At Mon, 17 Jan 2011 18:55:54 +0100, Bastien wrote: > > David Maus <dm...@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.... dmj...@jabber.org Email..... dm...@ictsoc.de
From ea1c1e8528af0490c03133a09575e72fa4d0f352 Mon Sep 17 00:00:00 2001
From: David Maus <dm...@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><" type ":"
+ (save-match-data (org-link-unescape path))
+ "></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><" type ":"
- (save-match-data (org-link-unescape path))
- "></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))
--
1.7.2.3
pgp4tZdN0IRS9.pgp
Description: PGP signature
_______________________________________________ Emacs-orgmode mailing list Please use `Reply All' to send replies to the list. Emacs-orgmode@gnu.org http://lists.gnu.org/mailman/listinfo/emacs-orgmode
