From: David Maus <dmaus@ictsoc.de>
To: Bastien <bastien.guerry@wikimedia.fr>
Cc: "David Maus" <dmaus@ictsoc.de>,
"Vincent Belaïche" <vincent.b.1@hotmail.fr>,
"Org mode" <emacs-orgmode@gnu.org>
Subject: Re: Export issue of URL when the text begins with a date
Date: Sun, 30 Jan 2011 18:20:28 +0100 [thread overview]
Message-ID: <87sjwae2ar.wl%dmaus@ictsoc.de> (raw)
In-Reply-To: <871v4btnx1.fsf@gnu.org>
[-- Attachment #1.1.1: Type: text/plain, Size: 1380 bytes --]
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
[-- Attachment #1.1.2: 0001-Factor-out-link-Handling-during-export.patch --]
[-- Type: text/plain, Size: 12245 bytes --]
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><" 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
[-- Attachment #1.2: Type: application/pgp-signature, Size: 230 bytes --]
[-- Attachment #2: Type: text/plain, Size: 201 bytes --]
_______________________________________________
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
next prev parent reply other threads:[~2011-01-30 17:25 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-01-14 21:12 Export issue of URL when the text begins with a date Vincent Belaïche
2011-01-15 6:40 ` David Maus
2011-01-17 17:55 ` Bastien
2011-01-30 17:20 ` David Maus [this message]
2011-01-31 18:29 ` [Accepted] " Bastien Guerry
2011-01-31 18:45 ` Bastien
2011-02-27 17:14 ` David Maus
-- strict thread matches above, loose matches on Subject: below --
2011-01-13 22:00 Vincent Belaïche
2011-01-14 5:44 ` David Maus
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87sjwae2ar.wl%dmaus@ictsoc.de \
--to=dmaus@ictsoc.de \
--cc=bastien.guerry@wikimedia.fr \
--cc=emacs-orgmode@gnu.org \
--cc=vincent.b.1@hotmail.fr \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).