From mboxrd@z Thu Jan 1 00:00:00 1970 From: "Tom Breton (Tehom)" Subject: org-html link building diff Date: Sat, 17 Apr 2010 22:13:11 -0400 Message-ID: <734f7527c1662e217d1ec2ad053118b2.squirrel@mail.panix.com> Mime-Version: 1.0 Content-Type: multipart/mixed;boundary="----=_20100417221311_69967" Return-path: Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1O3K0b-00084D-50 for emacs-orgmode@gnu.org; Sat, 17 Apr 2010 22:13:17 -0400 Received: from [140.186.70.92] (port=45274 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1O3K0Z-00082i-FE for Emacs-orgmode@gnu.org; Sat, 17 Apr 2010 22:13:16 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1O3K0W-0000xd-Pu for Emacs-orgmode@gnu.org; Sat, 17 Apr 2010 22:13:15 -0400 Received: from mail2.panix.com ([166.84.1.73]:61528) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1O3K0W-0000xS-Lc for Emacs-orgmode@gnu.org; Sat, 17 Apr 2010 22:13:12 -0400 Received: from mailbackend.panix.com (mailbackend.panix.com [166.84.1.89]) by mail2.panix.com (Postfix) with ESMTP id 286B438E46 for ; Sat, 17 Apr 2010 22:13:11 -0400 (EDT) Received: from mail.panix.com (localhost [127.0.0.1]) by mailbackend.panix.com (Postfix) with ESMTP id 300CB329D5 for ; Sat, 17 Apr 2010 22:13:11 -0400 (EDT) List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Emacs-orgmode@gnu.org ------=_20100417221311_69967 Content-Type: text/plain; charset="iso-8859-1" Content-Transfer-Encoding: quoted-printable 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) ------=_20100417221311_69967 Content-Type: text/x-patch; name="org-html.el.diff" Content-Disposition: attachment; filename="org-html.el.diff" Content-Transfer-Encoding: quoted-printable 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 retu= rn the buffer." =20 (defvar html-table-tag nil) ; dynamically scoped into this. (defvar org-par-open nil) +(defconst org-html-cvt-link-fn=20 + ;;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=20 + ;;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)=20 + "Make an HTML link +TYPE is the device-type of the link (And isn't used yet) (THIS://foo.htm= l) +PATH is the path of the link (http://THIS) +FRAGMENT is the fragment part of the link, if any (The foo.html#THIS par= t) +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=3D type "file") + ;;Substitute just if original path was absolute. + ;;(Otherwise path must remain relative) + (setq thefile=20 + (if (file-name-absolute-p filename)=20 + (expand-file-name filename)=20 + filename)) + =20 + (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))) + =20 + ;;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=3D type "http") + (string=3D type "https")) + (if fragment + (setq thefile (concat thefile "#" fragment)))) + =20 + (t)) + =20 + ;;Final URL-build, for all types. + (setq thefile=20 + (concat type ":" (org-export-html-format-href thefile))) + + (if (and=20 + may-inline-p + ;;Can't inline a URL with a fragment. + (not fragment) + (or=20 + (eq t org-export-html-inline-images) + (and=20 + 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=20 + "" + (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=3D\"%s\" xml:lang=3D\"%s\"> "\" class=3D\"target\">" (match-string 1 line) "@ ") t t line))))) - + =20 (setq line (org-html-handle-time-stamps line)) =20 ;; replace "&" by "&", "<" and ">" by "<" and ">" @@ -1070,28 +1170,25 @@ lang=3D\"%s\" xml:lang=3D\"%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=20 + (org-html-make-link + "file" id-file=20 + (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=3D\"%s\" xml:lang=3D\"%s\"> =20 ((string=3D 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 (=3D (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))) + =20 + (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))) + =20 + (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)))))) + =20 (t ;; just publish the path, as default (setq rpl (concat "<" type ":" @@ -1502,6 +1596,7 @@ lang=3D\"%s\" xml:lang=3D\"%s\"> (kill-buffer (current-buffer))) (current-buffer))))) =20 + (defun org-export-html-insert-plist-item (plist key &rest args) (let ((item (plist-get plist key))) (cond ((functionp item) ------=_20100417221311_69967 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ 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 ------=_20100417221311_69967--