mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-12-03 08:30:03 +00:00
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
This commit is contained in:
David Maus
Bastien Guerry
parent
7e608051ac
commit
24e664df07
332
lisp/org-html.el
332
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))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user