Allow attributes in hyperlinks.

This commit is contained in:
Carsten Dominik 2008-07-17 14:29:26 -07:00
parent 27403feed8
commit 3db122fdbb
3 changed files with 46 additions and 9 deletions

View File

@ -1,5 +1,13 @@
2008-07-17 Carsten Dominik <dominik@science.uva.nl>
* org.el (org-make-link-string): Remove link attributes from
description.
(org-open-at-point): Remove link attributes bevore using the path.
* org-exp.el (org-export-as-html): Handle link attributes.
* org.el (org-extract-attributes, org-attributes-to-string): New functions.
* org-table.el (org-table-to-lisp): New function.
* org.el (org-narrow-to-subtree): Do not include the final newline

View File

@ -2768,7 +2768,7 @@ PUB-DIR is set, use this as the publishing directory."
table-open type
table-buffer table-orig-buffer
ind item-type starter didclose
rpl path desc descp desc1 desc2 link
rpl path attr desc descp desc1 desc2 link
snumber fnc item-tag
)
@ -3025,7 +3025,8 @@ lang=\"%s\" xml:lang=\"%s\">
(setq start 0)
(while (string-match org-bracket-link-analytic-regexp line start)
(setq start (match-beginning 0))
(setq path (match-string 3 line))
(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
@ -3033,6 +3034,9 @@ lang=\"%s\" xml:lang=\"%s\">
(string-match "^\\.\\.?/" path)))
"file")
(t "internal")))
(setq path (org-extract-attributes path))
(setq attr (org-attributes-to-string
(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)))
@ -3051,15 +3055,16 @@ lang=\"%s\" xml:lang=\"%s\">
"<a href=\"#"
(org-solidify-link-text
(save-match-data (org-link-unescape path)) nil)
"\">" desc "</a>")))
"\"" attr ">" desc "</a>")))
((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))
(setq rpl (concat "<img src=\"" type ":" path "\"/>"))
(setq rpl (concat "<img src=\"" type ":" path "\"" attr "/>"))
(setq link (concat type ":" path))
(setq rpl (concat "<a href=\"" link "\">" desc "</a>"))))
(setq rpl (concat "<a href=\"" link "\"" attr ">"
desc "</a>"))))
((member type '("ftp" "mailto" "news"))
;; standard URL
(setq link (concat type ":" path))
@ -3107,8 +3112,9 @@ lang=\"%s\" xml:lang=\"%s\">
(or (eq t org-export-html-inline-images)
(and org-export-html-inline-images
(not descp))))
(concat "<img src=\"" thefile "\"/>")
(concat "<a href=\"" thefile "\">" desc "</a>")))
(concat "<img src=\"" thefile "\"" attr "/>")
(concat "<a href=\"" thefile "\"" attr ">"
desc "</a>")))
(if (not valid) (setq rpl desc))))
(t
@ -3371,6 +3377,7 @@ lang=\"%s\" xml:lang=\"%s\">
(kill-buffer (current-buffer)))
(current-buffer)))))
(defvar org-table-colgroup-info nil)
(defun org-format-table-ascii (lines)
"Format a table for ascii export."

View File

@ -6748,7 +6748,7 @@ according to FMT (default from `org-email-link-description-format')."
(setq description nil))
(when (and (not description)
(not (equal link (org-link-escape link))))
(setq description link))
(setq description (org-extract-attributes link)))
(concat "[[" (org-link-escape link) "]"
(if description (concat "[" description "]") "")
"]"))
@ -7021,6 +7021,27 @@ used as the link location instead of reading one interactively."
(org-defkey minibuffer-local-completion-map " " 'self-insert-command)
(apply 'completing-read args)))
(defun org-extract-attributes (s)
"Extract the attributes cookie from a string and set as text property."
(let (a attr (start 0))
(save-match-data
(when (string-match "{{\\([^}]+\\)}}$" s)
(setq a (match-string 1 s) s (substring s 0 (match-beginning 0)))
(while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"" a start)
(setq key (match-string 1 a) value (match-string 2 a)
start (match-end 0)
attr (plist-put attr (intern key) value))))
(org-add-props s nil 'org-attributes attr))
s))
(defun org-attributes-to-string (plist)
"Format a property list into an HTML attribute list."
(let ((s "") key value)
(while plist
(setq key (pop plist) value (pop plist))
(setq s (concat s " "(symbol-name key) "=\"" value "\"")))
s))
;;; Opening/following a link
(defvar org-link-search-failed nil)
@ -7121,7 +7142,8 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
(save-excursion
(skip-chars-forward "^]\n\r")
(when (org-in-regexp org-bracket-link-regexp)
(setq link (org-link-unescape (org-match-string-no-properties 1)))
(setq link (org-extract-attributes
(org-link-unescape (org-match-string-no-properties 1))))
(while (string-match " *\n *" link)
(setq link (replace-match " " t t link)))
(setq link (org-link-expand-abbrev link))