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 + "" + (org-export-html-format-desc desc) + ""))))) + +;;; 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) "@ ") 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 "" - (org-export-html-format-desc desc) - "")))) + (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 "" - (org-export-html-format-desc desc) - "")))) + ;; 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 "" - (org-export-html-format-desc desc) - ""))) - (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 "<" 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)