Moved to new branch
This commit is contained in:
Tom Breton (Tehom)
parent
679e3b7f03
commit
459d99c44c
323
lisp/org-html.el
323
lisp/org-html.el
|
|
@ -533,6 +533,130 @@ 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)
|
||||
|
||||
;;; org-html-cvt-link-fn
|
||||
(defconst org-html-cvt-link-fn
|
||||
nil
|
||||
"Function to convert link URLs to exportable URLs.
|
||||
Takes two arguments, TYPE and PATH.
|
||||
Returns exportable url as (TYPE PATH), or `nil' to signal that it
|
||||
didn't handle this case.
|
||||
Intended to be locally bound around a call to `org-export-as-html'." )
|
||||
|
||||
(defun org-html-cvt-org-as-html (opt-plist type path)
|
||||
"Convert and org filename to an equivalent html filename.
|
||||
If TYPE is not file, just return `nil'.
|
||||
See variable `org-export-html-link-org-files-as-html'"
|
||||
|
||||
(save-match-data
|
||||
(and
|
||||
org-export-html-link-org-files-as-html
|
||||
(string= type "file")
|
||||
(string-match "\\.org$" path)
|
||||
(progn
|
||||
(list
|
||||
"http"
|
||||
(concat
|
||||
(substring path 0 (match-beginning 0))
|
||||
"."
|
||||
(plist-get opt-plist :html-extension)))))))
|
||||
|
||||
|
||||
;;; org-html-should-inline-p
|
||||
(defun org-html-should-inline-p (filename descp)
|
||||
"Return non-nil if link FILENAME should be inlined, according to
|
||||
current settings.
|
||||
DESCP is the boolean of whether there was a link description.
|
||||
See variables `org-export-html-inline-images' and
|
||||
`org-export-html-inline-image-extensions'."
|
||||
(declare (special
|
||||
org-export-html-inline-images
|
||||
org-export-html-inline-image-extensions))
|
||||
(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))
|
||||
|
||||
;;; org-html-make-link
|
||||
(defun org-html-make-link (opt-plist type path fragment desc attr
|
||||
may-inline-p)
|
||||
"Make an HTML link.
|
||||
OPT-PLIST is an options list.
|
||||
TYPE is the device-type of the link (THIS://foo.html)
|
||||
PATH is the path of the link (http://THIS#locationx)
|
||||
FRAGMENT is the fragment part of the link, if any (foo.html#THIS)
|
||||
DESC is the link description, if any.
|
||||
ATTR is a string of other attributes of the a element.
|
||||
MAY-INLINE-P allows inlining it as an image."
|
||||
|
||||
(declare (special org-par-open))
|
||||
(save-match-data
|
||||
(let* ((filename path)
|
||||
;;First pass. Just sanity stuff.
|
||||
(components-1
|
||||
(cond
|
||||
((string= type "file")
|
||||
(list
|
||||
type
|
||||
;;Substitute just if original path was absolute.
|
||||
;;(Otherwise path must remain relative)
|
||||
(if (file-name-absolute-p path)
|
||||
(expand-file-name path)
|
||||
path)))
|
||||
((string= type "")
|
||||
(list nil path))
|
||||
(t (list type path))))
|
||||
|
||||
;;Second pass. Components converted so they can refer
|
||||
;;to a remote site.
|
||||
(components-2
|
||||
(or
|
||||
(and org-html-cvt-link-fn
|
||||
(apply org-html-cvt-link-fn
|
||||
opt-plist components-1))
|
||||
(apply #'org-html-cvt-org-as-html
|
||||
opt-plist components-1)
|
||||
components-1))
|
||||
(type (first components-2))
|
||||
(thefile (second components-2)))
|
||||
|
||||
|
||||
;;Third pass. Build final link except for leading type
|
||||
;;spec.
|
||||
(cond
|
||||
((or
|
||||
(not type)
|
||||
(string= type "http")
|
||||
(string= type "https"))
|
||||
(if fragment
|
||||
(setq thefile (concat thefile "#" fragment))))
|
||||
|
||||
(t))
|
||||
|
||||
;;Final URL-build, for all types.
|
||||
(setq thefile
|
||||
(let
|
||||
((str (org-export-html-format-href thefile)))
|
||||
(if type
|
||||
(concat type ":" str)
|
||||
str)))
|
||||
|
||||
(if (and
|
||||
may-inline-p
|
||||
;;Can't inline a URL with a fragment.
|
||||
(not fragment))
|
||||
(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)
|
||||
|
|
@ -1046,71 +1170,71 @@ lang=\"%s\" xml:lang=\"%s\">
|
|||
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))))
|
||||
;; FIXME: do we need to unescape here somewhere?
|
||||
(cond
|
||||
((equal type "internal")
|
||||
(setq rpl
|
||||
(concat
|
||||
"<a href=\""
|
||||
(if (= (string-to-char path) ?#) "" "#")
|
||||
(org-solidify-link-text
|
||||
(save-match-data (org-link-unescape path)) nil)
|
||||
"\"" attr ">"
|
||||
(org-export-html-format-desc desc)
|
||||
"</a>")))
|
||||
(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 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>"))))
|
||||
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, 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, 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
|
||||
(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, can't inline as image
|
||||
(setq rpl
|
||||
(org-html-make-link opt-plist
|
||||
type path nil
|
||||
desc
|
||||
attr
|
||||
nil)))
|
||||
|
||||
((string= type "coderef")
|
||||
(setq rpl (format "<a href=\"#coderef-%s\" class=\"coderef\" onmouseover=\"CodeHighlightOn(this, 'coderef-%s');\" onmouseout=\"CodeHighlightOff(this, 'coderef-%s');\">%s</a>"
|
||||
path path path
|
||||
(format (org-export-get-coderef-format path (and descp desc))
|
||||
(cdr (assoc path org-export-code-refs))))))
|
||||
|
||||
(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
|
||||
|
|
@ -1118,53 +1242,56 @@ lang=\"%s\" xml:lang=\"%s\">
|
|||
(funcall fnc (org-link-unescape path) desc1 'html))))
|
||||
|
||||
((string= type "file")
|
||||
;; FILE link
|
||||
(let* ((filename path)
|
||||
(abs-p (file-name-absolute-p filename))
|
||||
thefile file-is-image-p search)
|
||||
;; FILE link
|
||||
(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*
|
||||
((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 ":"
|
||||
|
|
|
|||
Loading…
Reference in New Issue