Coderefs: Revamp label syntax.

This commit revamps the syntax used for code line references in
literal examples.  See the documentation for details about the new
format.

3 files changed, 90 insertions, 24 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 15bad2dab..2a0afa66c 100755
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,14 @@
 2009-01-05  Carsten Dominik  <carsten.dominik@gmail.com>
 
+	* org.el (org-edit-src-get-label-format): New function.
+	(org-coderef-label-format): New option.
+	(org-edit-src-code, org-edit-src-find-region-and-lang): Parse for
+	a label format specification and make sure it is used in the edit
+	buffer.
+	(org-edit-src-get-label-format): New function.
+	(org-store-link): Handle new coderef formats.
+	(org-link-search): Handle new coderef formats.
+
 	* org-footnote.el (org-footnote-create-definition)
 	(org-footnote-goto-local-insertion-point): Make footnote insertion
 	work correctly when the "Footnotes" headline is the last line in
diff --git a/lisp/org-exp.el b/lisp/org-exp.el
index 0f8aae539..4bef5597c 100644
--- a/lisp/org-exp.el
+++ b/lisp/org-exp.el
@@ -1700,7 +1700,7 @@ the current file."
 	      ((cdr (assoc slink target-alist)))
 	      ((and (string-match "^id:" link)
 		    (cdr (assoc (substring link 3) target-alist))))
-	      ((string-match "^((\\(.*\\)))$" link)
+	      ((string-match "^(\\(.*\\))$" link)
 	       (setq cref (match-string 1 link))
 	       (concat "coderef:" cref))
 	      ((string-match org-link-types-re link) nil)
@@ -2305,11 +2305,14 @@ and `+n' for continuing previous numering.
 Code formatting according to language currently only works for HTML.
 Numbering lines works for all three major backends (html, latex, and ascii)."
   (save-match-data
-    (let (num cont rtn named rpllbl keepp)
-      (setq num (string-match "[-+]n\\>" (or opts ""))
-	    cont (string-match "\\+n\\>" (or opts ""))
-	    rpllbl (string-match "-r\\>" (or opts ""))
-	    keepp (string-match "-k\\>" (or opts "")))
+    (let (num cont rtn named rpllbl keepp fmt)
+      (setq opts (or opts "")
+	    num (string-match "[-+]n\\>" opts)
+	    cont (string-match "\\+n\\>" opts)
+	    rpllbl (string-match "-r\\>" opts)
+	    keepp (string-match "-k\\>" opts)
+	    fmt (if (string-match "-l[ \t]+\"\\([^\"\n]+\\)\"" opts)
+		    (match-string 1 opts)))
       (if keepp (setq rpllbl 'keep))
       (setq rtn code)
       (when (equal lang "org")
@@ -2350,15 +2353,15 @@ Numbering lines works for all three major backends (html, latex, and ascii)."
 			     (format "<pre class=\"src src-%s\">\n" lang)
 			     t t rtn))))
 	  (setq rtn (concat "<pre class=\"example\">\n" rtn "</pre>\n")))
-	(setq rtn (org-export-number-lines rtn 'html 1 1 num cont rpllbl))
+	(setq rtn (org-export-number-lines rtn 'html 1 1 num cont rpllbl fmt))
 	(concat "\n#+BEGIN_HTML\n" rtn "\n#+END_HTML\n\n"))
        ((eq backend 'latex)
-	(setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl))
+	(setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt))
 	(concat "\n#+BEGIN_LaTeX\n\\begin{verbatim}\n" rtn
 		"\n\\end{verbatim}\n#+END_LaTeX\n\n"))
        ((eq backend 'ascii)
 	;; This is not HTML or LaTeX, so just make it an example.
-	(setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl))
+	(setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt))
 	(concat "#+BEGIN_ASCII\n"
 		(mapconcat
 		 (lambda (l) (concat "  " l))
@@ -2368,7 +2371,7 @@ Numbering lines works for all three major backends (html, latex, and ascii)."
 
 (defun org-export-number-lines (text backend
 				     &optional skip1 skip2 number cont
-				     replace-labels)
+				     replace-labels label-format)
   (if (and (not number) (not (eq replace-labels 'keep)))
       (setq replace-labels nil)) ;; must use names if no numbers
   (setq skip1 (or skip1 0) skip2 (or skip2 0))
@@ -2390,6 +2393,20 @@ Numbering lines works for all three major backends (html, latex, and ascii)."
 	     ((eq backend 'ascii) fmt)
 	     ((eq backend 'latex) fmt)
 	     (t "")))
+	   (label-format (or label-format org-coderef-label-format))
+	   (label-pre (if (string-match "%s" label-format)
+			  (substring label-format 0 (match-beginning 0))
+			label-format))
+	   (label-post (if (string-match "%s" label-format)
+			   (substring label-format (match-end 0))
+			 ""))
+	   (lbl-re
+	    (concat 
+	     ".*?\\S-.*?\\([ \t]*\\("
+	     (regexp-quote label-pre)
+	     "\\([-a-zA-Z0-9_]+\\)"
+	     (regexp-quote label-post)
+	     "\\)\\)"))
 	   ref)
 
       (goto-line (1+ skip1))
@@ -2398,7 +2415,7 @@ Numbering lines works for all three major backends (html, latex, and ascii)."
 	    (insert (format fm (incf n)))
 	  (forward-char 1))
 	(when (and (not (eq replace-labels 'keep))
-		   (looking-at ".*?\\([ \t]+\\(((\\(.*?\\)))\\)\\)"))
+		   (looking-at lbl-re))
 	  (setq ref (match-string 3))
 	  (if replace-labels
 	      (progn
@@ -3869,7 +3886,7 @@ lang=\"%s\" xml:lang=\"%s\">
 (defun org-export-get-coderef-format (path desc)
   (save-match-data
     (if (and desc (string-match
-		   (regexp-quote (concat "((" path "))"))
+		   (regexp-quote (concat "(" path ")"))
 		   desc))
 	(replace-match "%s" t t desc)
       "%s")))
diff --git a/lisp/org.el b/lisp/org.el
index d4360efa9..e9a4a723c 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -729,6 +729,23 @@ there are kept outside the narrowed region."
 		   (const :tag "from `lang' element")
 		   (const :tag "from `style' element")))))
 
+(defcustom org-coderef-label-format "(ref:%s)"
+  "The default coderef format.
+This format string will be used to search for coderef labels in literal
+examples (EXAMPLE and SRC blocks).  The format can be overwritten
+an individual literal example with the -f option, like
+
+#+BEGIN_SRC pascal +n -r -l \"((%s))\"
+...
+#+END_SRC
+
+If you want to use this for HTML export, make sure that the format does
+not introduce special font-locking, and avoid the HTML special
+characters `<', `>', and `&'.  The reason for this restriction is that
+the labels are searched for only after htmlize has done its job."
+  :group 'org-edit-structure ; FIXME this is not in the right group
+  :type 'string)
+
 (defcustom org-edit-fixed-width-region-mode 'artist-mode
   "The mode that should be used to edit fixed-width regions.
 These are the regions where each line starts with a colon."
@@ -5729,13 +5746,14 @@ exit by killing the buffer with \\[org-edit-src-exit]."
 	      "Edit, then exit with C-c ' (C-c and single quote)"))
 	(info (org-edit-src-find-region-and-lang))
 	(org-mode-p (eq major-mode 'org-mode))
-	beg end lang lang-f single)
+	beg end lang lang-f single lfmt)
     (if (not info)
 	nil
       (setq beg (nth 0 info)
 	    end (nth 1 info)
 	    lang (nth 2 info)
 	    single (nth 3 info)
+	    lfmt (nth 4 info)
 	    lang-f (intern (concat lang "-mode")))
       (unless (functionp lang-f)
 	(error "No such language mode: %s" lang-f))
@@ -5751,6 +5769,8 @@ exit by killing the buffer with \\[org-edit-src-exit]."
 	(funcall lang-f))
       (set (make-local-variable 'org-edit-src-force-single-line) single)
       (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
+      (when lfmt
+	(set (make-local-variable 'org-coderef-label-format) lfmt))
       (when org-mode-p
 	(goto-char (point-min))
 	(while (re-search-forward "^," nil t)
@@ -5841,7 +5861,7 @@ the language, a switch telling of the content should be in a single line."
 	    ("^#\\+ascii:" "\n" "ascii" single-line)
 	    )))
 	(pos (point))
-	re re1 re2 single beg end lang)
+	re re1 re2 single beg end lang lfmt match-re1)
     (catch 'exit
       (while (setq entry (pop re-list))
 	(setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry)
@@ -5850,19 +5870,27 @@ the language, a switch telling of the content should be in a single line."
 	  (if (or (looking-at re1)
 		  (re-search-backward re1 nil t))
 	      (progn
-		(setq beg (match-end 0) lang (org-edit-src-get-lang lang))
+		(setq match-re1 (match-string 0))
+		(setq beg (match-end 0)
+		      lang (org-edit-src-get-lang lang)
+		      lfmt (org-edit-src-get-label-format match-re1))
 		(if (and (re-search-forward re2 nil t)
 			 (>= (match-end 0) pos))
-		    (throw 'exit (list beg (match-beginning 0) lang single))))
+		    (throw 'exit (list beg (match-beginning 0)
+				       lang single lfmt))))
 	    (if (or (looking-at re2)
 		    (re-search-forward re2 nil t))
 		(progn
 		  (setq end (match-beginning 0))
 		  (if (and (re-search-backward re1 nil t)
 			   (<= (match-beginning 0) pos))
-		      (throw 'exit
-			     (list (match-end 0) end
-				   (org-edit-src-get-lang lang) single)))))))))))
+		      (progn
+			(setq lfmt (org-edit-src-get-label-format
+				    (match-string 0)))
+			(throw 'exit
+			       (list (match-end 0) end
+				     (org-edit-src-get-lang lang)
+				     single lfmt))))))))))))
 
 (defun org-edit-src-get-lang (lang)
   "Extract the src language."
@@ -5878,6 +5906,12 @@ the language, a switch telling of the content should be in a single line."
       (match-string 1 m))
      (t "fundamental"))))
 
+(defun org-edit-src-get-label-format (s)
+  "Extract the label format."
+  (save-match-data
+    (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s)
+	(match-string 1 s))))
+
 (defun org-edit-src-exit ()
   "Exit special edit and protect problematic lines."
   (interactive)
@@ -6265,15 +6299,17 @@ For file links, arg negates `org-context-in-file-links'."
 		     (save-restriction
 		       (widen)
 		       (goto-char (point-min))
-		       (re-search-forward (concat "((" label "))") nil t))))
+		       (re-search-forward
+			(regexp-quote (format org-coderef-label-format label))
+			nil t))))
 	  (when label (message "Label exists already") (sit-for 2))
 	  (setq label (read-string "Code line label: " label)))
 	(end-of-line 1)
-	(setq link (format "((%s))" label))
+	(setq link (format org-coderef-label-format label))
 	(setq gc (- 79 (length link)))
 	(if (< (current-column) gc) (org-move-to-column gc t) (insert " "))
 	(insert link)
-	(setq desc nil)))
+	(setq link (concat "(" label ")") desc nil)))
 
      ((eq major-mode 'calendar-mode)
       (let ((cd (calendar-cursor-to-date)))
@@ -7170,11 +7206,15 @@ in all files.  If AVOID-POS is given, ignore matches near that position."
 	       pos (match-beginning 0))))
       ;; There is an exact target for this
       (goto-char pos))
-     ((and (string-match "^((.*))$" s0)
+     ((and (string-match "^(\\(.*\\))$" s0)
 	   (save-excursion
 	     (goto-char (point-min))
 	     (and
-	      (re-search-forward (concat "[^[]" (regexp-quote s0)) nil t)
+	      (re-search-forward
+	       (concat "[^[]" (regexp-quote
+			       (format org-coderef-label-format
+				       (match-string 1 s0))))
+	       nil t)
 	      (setq type 'dedicated
 		    pos (1+ (match-beginning 0))))))
       ;; There is a coderef target for this