From: "Tom Breton (Tehom)" <tehom@panix.com>
To: Emacs-orgmode@gnu.org
Subject: org-html link building diff
Date: Sat, 17 Apr 2010 22:13:11 -0400 [thread overview]
Message-ID: <734f7527c1662e217d1ec2ad053118b2.squirrel@mail.panix.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 894 bytes --]
I've refactored `org-export-as-html', factored code to build links
into `org-html-make-link'.
This does two things that I needed:
* It allows custom link types to build anchors.
* How: Call org-html-make-link. Many parameters, see the function
docstring. It returns a string containing an HTML link.
* It adds the capability to convert links when exporting.
* How: Around the export call, bind org-html-cvt-link-fn to a
function that takes 1 parameter (filename) and returns a url as a
string.
I think it also makes the code cleaner.
There are more things that could be done - it's only used by some of
the cond branches, the others are unchanged. But "publish early and
often", so here it is.
I will append the changes as a diff, since I can't push to the org
repository ("fatal: The remote end hung up unexpectedly")
Tom Breton (Tehom)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: org-html.el.diff --]
[-- Type: text/x-patch; name="org-html.el.diff", Size: 9145 bytes --]
diff --git a/lisp/org-html.el b/lisp/org-html.el
index 74f3a55..9aaadec 100644
--- a/lisp/org-html.el
+++ b/lisp/org-html.el
@@ -533,6 +533,106 @@ in a window. A non-interactive call will only return the buffer."
(defvar html-table-tag nil) ; dynamically scoped into this.
(defvar org-par-open nil)
+(defconst org-html-cvt-link-fn
+ ;;In the future this might change to take more args: type + path +
+ ;;fragment
+ #'identity
+ "Function to convert link URLs to exportable URLs.
+Takes one argument, PATH.
+Returns exportable URL.
+Intended to be locally bound around a call to `org-export-as-html'." )
+
+;;; org-html-cvt-link-fn
+(defconst org-html-cvt-link-fn
+ ;;In the future this might change to take more args: type + path +
+ ;;fragment
+ #'identity
+ "Function to convert link URLs to exportable URLs.
+Takes one argument, PATH.
+Returns exportable URL.
+Intended for remote exporting." )
+
+
+;;; org-html-make-link
+;;Special variables seen:
+;;`html-extension' -- From plist
+;;`org-par-open' is a special variable so it's not in the arglist.
+(defun org-html-make-link (type path fragment desc descp attr
+ may-inline-p)
+ "Make an HTML link
+TYPE is the device-type of the link (And isn't used yet) (THIS://foo.html)
+PATH is the path of the link (http://THIS)
+FRAGMENT is the fragment part of the link, if any (The foo.html#THIS part)
+DESC is the link description, if any.
+DESCP is whether there originally was a description.
+ATTR is a string of other attributes of the a element.
+MAY-INLINE-P allows inlining it as an image."
+
+ (declare (special html-extension org-par-open))
+ (let ((filename path)
+ thefile)
+ (save-match-data
+ ;;First pass. Mostly deals with treating local files. TYPE
+ ;;may still change.
+ (cond
+ ((string= type "file")
+ ;;Substitute just if original path was absolute.
+ ;;(Otherwise path must remain relative)
+ (setq thefile
+ (if (file-name-absolute-p filename)
+ (expand-file-name filename)
+ filename))
+
+ (when (and org-export-html-link-org-files-as-html
+ (string-match "\\.org$" thefile))
+ (setq type "http")
+ (setq thefile (concat (substring thefile 0
+ (match-beginning 0))
+ "." html-extension))))
+ (t (setq thefile filename)))
+
+ ;;If applicable, convert local path to remote URL
+ (setq thefile
+ (or
+ (funcall org-html-cvt-link-fn thefile)
+ thefile))
+
+ ;;Second pass. Build final link except for leading type
+ ;;spec. Now TYPE is final.
+ (cond
+ ((or
+ (string= type "http")
+ (string= type "https"))
+ (if fragment
+ (setq thefile (concat thefile "#" fragment))))
+
+ (t))
+
+ ;;Final URL-build, for all types.
+ (setq thefile
+ (concat type ":" (org-export-html-format-href thefile)))
+
+ (if (and
+ may-inline-p
+ ;;Can't inline a URL with a fragment.
+ (not fragment)
+ (or
+ (eq t org-export-html-inline-images)
+ (and
+ org-export-html-inline-images
+ (not descp)))
+ (org-file-image-p
+ filename org-export-html-inline-image-extensions))
+
+ (progn
+ (message "image %s %s" thefile org-par-open)
+ (org-export-html-format-image thefile org-par-open))
+ (concat
+ "<a href=\"" thefile "\"" attr ">"
+ (org-export-html-format-desc desc)
+ "</a>")))))
+
+;;; org-export-as-html
;;;###autoload
(defun org-export-as-html (arg &optional hidden ext-plist
to-buffer body-only pub-dir)
@@ -1014,7 +1114,7 @@ lang=\"%s\" xml:lang=\"%s\">
"\" class=\"target\">" (match-string 1 line)
"@</a> ")
t t line)))))
-
+
(setq line (org-html-handle-time-stamps line))
;; replace "&" by "&", "<" and ">" by "<" and ">"
@@ -1070,28 +1170,25 @@ lang=\"%s\" xml:lang=\"%s\">
(save-match-data
(setq id-file (file-relative-name
id-file (file-name-directory org-current-export-file)))
- (setq id-file (concat (file-name-sans-extension id-file)
- "." html-extension))
- (setq rpl (concat "<a href=\"" id-file "#"
- (if (org-uuidgen-p path) "ID-")
- path "\""
- attr ">"
- (org-export-html-format-desc desc)
- "</a>"))))
+ (setq rpl
+ (org-html-make-link
+ "file" id-file
+ (concat (if (org-uuidgen-p path) "ID-") path)
+ (org-export-html-format-desc desc)
+ descp
+ attr
+ nil))))
((member type '("http" "https"))
- ;; standard URL, just check if we need to inline an image
- (if (and (or (eq t org-export-html-inline-images)
- (and org-export-html-inline-images (not descp)))
- (org-file-image-p
- path org-export-html-inline-image-extensions))
- (setq rpl (org-export-html-format-image
- (concat type ":" path) org-par-open))
- (setq link (concat type ":" path))
- (setq rpl (concat "<a href=\""
- (org-export-html-format-href link)
- "\"" attr ">"
- (org-export-html-format-desc desc)
- "</a>"))))
+ ;; standard URL, just check if we need to inline an
+ ;; image
+ (setq rpl
+ (org-html-make-link
+ type path nil
+ (org-export-html-format-desc desc)
+ descp
+ attr
+ ;;But desc already becomes image.
+ t)))
((member type '("ftp" "mailto" "news"))
;; standard URL
(setq link (concat type ":" path))
@@ -1115,52 +1212,49 @@ lang=\"%s\" xml:lang=\"%s\">
((string= type "file")
;; FILE link
- (let* ((filename path)
- (abs-p (file-name-absolute-p filename))
- thefile file-is-image-p search)
(save-match-data
- (if (string-match "::\\(.*\\)" filename)
- (setq search (match-string 1 filename)
- filename (replace-match "" t nil filename)))
- (setq valid
- (if (functionp link-validate)
- (funcall link-validate filename current-dir)
- t))
- (setq file-is-image-p
- (org-file-image-p
- filename org-export-html-inline-image-extensions))
- (setq thefile (if abs-p (expand-file-name filename) filename))
- (when (and org-export-html-link-org-files-as-html
- (string-match "\\.org$" thefile))
- (setq thefile (concat (substring thefile 0
- (match-beginning 0))
- "." html-extension))
- (if (and search
- ;; make sure this is can be used as target search
- (not (string-match "^[0-9]*$" search))
- (not (string-match "^\\*" search))
- (not (string-match "^/.*/$" search)))
- (setq thefile
- (concat thefile
- (if (= (string-to-char search) ?#) "" "#")
- (org-solidify-link-text
- (org-link-unescape search)))))
- (when (string-match "^file:" desc)
- (setq desc (replace-match "" t t desc))
- (if (string-match "\\.org$" desc)
- (setq desc (replace-match "" t t desc))))))
- (setq rpl (if (and file-is-image-p
- (or (eq t org-export-html-inline-images)
- (and org-export-html-inline-images
- (not descp))))
- (progn
- (message "image %s %s" thefile org-par-open)
- (org-export-html-format-image thefile org-par-open))
- (concat "<a href=\"" thefile "\"" attr ">"
- (org-export-html-format-desc desc)
- "</a>")))
- (if (not valid) (setq rpl desc))))
-
+ (let*
+ ((frag-p
+ (string-match "::\\(.*\\)" path))
+ ;;Get the proper path
+ (path-1
+ (if frag-p
+ (replace-match "" t nil path)
+ path))
+ ;;Get the raw fragment
+ (fragment-0
+ (match-string 1 filename))
+ ;;Check the fragment. If it can't be used as
+ ;;target fragment we'll use nil instead.
+ (fragment-1
+ (if
+ (and frag-p
+ (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
+ (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
+ "file" path-1 fragment-1 desc-2 descp
+ attr t))))))
+
(t
;; just publish the path, as default
(setq rpl (concat "<i><" type ":"
@@ -1502,6 +1596,7 @@ lang=\"%s\" xml:lang=\"%s\">
(kill-buffer (current-buffer)))
(current-buffer)))))
+
(defun org-export-html-insert-plist-item (plist key &rest args)
(let ((item (plist-get plist key)))
(cond ((functionp item)
[-- Attachment #3: 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 reply other threads:[~2010-04-18 2:13 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2010-04-18 2:13 Tom Breton (Tehom) [this message]
2010-04-26 5:24 ` org-html link building diff Carsten Dominik
2010-04-26 10:03 ` Sebastian Rose
2010-04-26 19:45 ` Tom Breton (Tehom)
2010-04-27 6:07 ` Carsten Dominik
2010-04-28 3:01 ` Tom Breton (Tehom)
2010-04-28 15:07 ` Carsten Dominik
-- strict thread matches above, loose matches on Subject: below --
2010-04-29 22:24 Tom Breton (Tehom)
2010-05-01 12:01 ` Carsten Dominik
2010-05-15 12:29 ` Carsten Dominik
2010-05-15 21:37 ` Tom Breton (Tehom)
2010-05-16 5:03 ` Carsten Dominik
2010-05-18 0:59 ` Tom Breton (Tehom)
2010-05-18 4:47 ` Carsten Dominik
2010-05-18 12:26 ` Sebastian Rose
2010-05-16 5:20 ` Carsten Dominik
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=734f7527c1662e217d1ec2ad053118b2.squirrel@mail.panix.com \
--to=tehom@panix.com \
--cc=Emacs-orgmode@gnu.org \
/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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.