diff --git a/lisp/org-html.el b/lisp/org-html.el
index 9a5d2257f..221685289 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))