Browse Source

Allow attributes in hyperlinks.

Carsten Dominik 16 years ago
parent
commit
3db122fdbb
3 changed files with 46 additions and 9 deletions
  1. 8 0
      lisp/ChangeLog
  2. 14 7
      lisp/org-exp.el
  3. 24 2
      lisp/org.el

+ 8 - 0
lisp/ChangeLog

@@ -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

+ 14 - 7
lisp/org-exp.el

@@ -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."

+ 24 - 2
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))