mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-08-27 08:32:52 +00:00
Allow attributes in hyperlinks.
This commit is contained in:
Carsten Dominik
parent
27403feed8
commit
3db122fdbb
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
26
lisp/org.el
26
lisp/org.el
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in a new issue