org-export: Change source code handling API

* contrib/lisp/org-element.el (org-element-example-block-parser,
  org-element-src-block-parser): Add `:number-lines',
  `:preserve-indent, `:retain-labels', `:use-labels'  and
  `:label-fmt' properties.
* contrib/lisp/org-export.el (org-export-resolve-coderef,
  org-export-get-loc): Apply changes to src-block and example-block
  elements' properties.
(org-export-unravel-code, org-export-format-code,
org-export-format-code-default): New functions.
(org-export-handle-code): Removed function.
* EXPERIMENTAL/org-e-latex.el (org-e-latex-example-block): Use new
  function.
(org-e-latex-src-block): Use new API.  Better handling of numbered
lines with special packages.
* EXPERIMENTAL/org-e-ascii.el (org-e-ascii-example-block,
  org-e-ascii-src-block): Use new functions.
* testing/lisp/test-org-element.el: Add tests.
* testing/lisp/test-org-export.el: Add tests.

EXPERIMENTAL/org-e-ascii.el

@@ -50,6 +50,7 @@
 (declare-function org-export-collect-tables "org-export" (info))
 (declare-function org-export-data "org-export" (data backend info))
 (declare-function org-export-expand-macro "org-export" (macro info))
+(declare-function org-export-format-code-default "org-export" (element info))
 (declare-function org-export-get-coderef-format "org-export" (path desc))
 (declare-function org-export-get-footnote-number "org-export" (footnote info))
 (declare-function org-export-get-headline-number "org-export" (headline info))
@@ -57,8 +58,6 @@
 		  (element info &optional types predicate))
 (declare-function org-export-get-parent-headline "org-export" (blob info))
 (declare-function org-export-get-relative-level "org-export" (headline info))
-(declare-function org-export-handle-code
-		  "org-export" (element info &optional num-fmt ref-fmt delayed))
 (declare-function org-export-included-file "org-export" (keyword backend info))
 (declare-function org-export-low-level-p "org-export" (headline info))
 (declare-function org-export-output-file-name "org-export"
@@ -1082,7 +1081,8 @@ contextual information."
 (defun org-e-ascii-example-block (example-block contents info)
   "Transcode a EXAMPLE-BLOCK element from Org to ASCII.
 CONTENTS is nil.  INFO is a plist holding contextual information."
-  (org-e-ascii--box-string (org-export-handle-code example-block info) info))
+  (org-e-ascii--box-string
+   (org-export-format-code-default example-block info) info))
 
 
 ;;;; Export Snippet
@@ -1546,7 +1546,8 @@ contextual information."
   (let ((caption (org-e-ascii--build-caption src-block info)))
     (concat
      (when (and caption org-e-ascii-caption-above) (concat caption "\n"))
-     (org-e-ascii--box-string (org-export-handle-code src-block info) info)
+     (org-e-ascii--box-string
+      (org-export-format-code-default src-block info) info)
      (when (and caption (not org-e-ascii-caption-above))
        (concat "\n" caption)))))
 

EXPERIMENTAL/org-e-latex.el

@@ -54,13 +54,16 @@
 (declare-function org-export-first-sibling-p "org-export" (headline info))
 (declare-function org-export-footnote-first-reference-p "org-export"
 		  (footnote-reference info))
+(declare-function org-export-format-code "org-export"
+		  (code fun &optional num-lines ref-alist))
+(declare-function org-export-format-code-default "org-export" (element info))
 (declare-function org-export-get-coderef-format "org-export" (path desc))
 (declare-function org-export-get-footnote-definition "org-export"
 		  (footnote-reference info))
 (declare-function org-export-get-footnote-number "org-export" (footnote info))
 (declare-function org-export-get-previous-element "org-export" (blob info))
 (declare-function org-export-get-relative-level "org-export" (headline info))
-(declare-function org-export-handle-code
+(declare-function org-export-unravel-code
 		  "org-export" (element info &optional num-fmt ref-fmt delayed))
 (declare-function org-export-included-file "org-export" (keyword backend info))
 (declare-function org-export-inline-image-p "org-export"
@@ -959,12 +962,13 @@ contextual information."
 ;;;; Example Block
 
 (defun org-e-latex-example-block (example-block contents info)
-  "Transcode a EXAMPLE-BLOCK element from Org to LaTeX.
-CONTENTS is nil.  INFO is a plist holding contextual information."
-  (let* ((options (or (org-element-property :options example-block) ""))
-	 (value (org-export-handle-code example-block info)))
-    (org-e-latex--wrap-label
-     example-block (format "\\begin{verbatim}\n%s\\end{verbatim}" value))))
+  "Transcode an EXAMPLE-BLOCK element from Org to LaTeX.
+CONTENTS is nil.  INFO is a plist holding contextual
+information."
+  (org-e-latex--wrap-label
+   example-block
+   (format "\\begin{verbatim}\n%s\\end{verbatim}"
+	   (org-export-format-code-default example-block info))))
 
 
 ;;;; Export Snippet
@@ -1674,39 +1678,68 @@ holding contextual information."
 CONTENTS holds the contents of the item.  INFO is a plist holding
 contextual information."
   (let* ((lang (org-element-property :language src-block))
-	 (code (org-export-handle-code src-block info))
 	 (caption (org-element-property :caption src-block))
 	 (label (org-element-property :name src-block))
 	 (custom-env (and lang
 			  (cadr (assq (intern lang)
-				      org-e-latex-custom-lang-environments)))))
+				      org-e-latex-custom-lang-environments))))
+	 (num-start (case (org-element-property :number-lines src-block)
+		      (continued (org-export-get-loc src-block info))
+		      (new 0)))
+	 (retain-labels (org-element-property :retain-labels src-block)))
     (cond
-     ;; No source fontification.
+     ;; Case 1.  No source fontification.
      ((not org-e-latex-listings)
-      (let ((caption-str (org-e-latex--caption/label-string
-			  caption label info))
+      (let ((caption-str (org-e-latex--caption/label-string caption label info))
 	    (float-env (when caption "\\begin{figure}[H]\n%s\n\\end{figure}")))
-	(format (or float-env "%s")
-		(concat
-		 caption-str
-		 (format "\\begin{verbatim}\n%s\\end{verbatim}" code)))))
-     ;; Custom environment.
-     (custom-env
-      (format "\\begin{%s}\n%s\\end{%s}\n" custom-env code custom-env))
-     ;; Use minted package.
+	(format
+	 (or float-env "%s")
+	 (concat caption-str
+		 (format "\\begin{verbatim}\n%s\\end{verbatim}"
+			 (org-export-format-code-default src-block info))))))
+     ;; Case 2.  Custom environment.
+     (custom-env (format "\\begin{%s}\n%s\\end{%s}\n"
+			 custom-env
+			 (org-export-format-code-default src-block info)
+			 custom-env))
+     ;; Case 3.  Use minted package.
      ((eq org-e-latex-listings 'minted)
-      (let* ((mint-lang (or (cadr (assq (intern lang) org-e-latex-minted-langs))
-			    lang))
-	     (float-env (when (or label caption)
-			  (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}"
-				  (org-e-latex--caption/label-string
-				   caption label info))))
-	     (body (format "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
-			   (org-e-latex--make-option-string
-			    org-e-latex-minted-options)
-			   mint-lang code)))
+      (let ((float-env (when (or label caption)
+			 (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}"
+				 (org-e-latex--caption/label-string
+				  caption label info))))
+	    (body
+	     (format
+	      "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
+	      ;; Options.
+	      (org-e-latex--make-option-string
+	       (if (not num-start) org-e-latex-minted-options
+		 (append `(("linenos")
+			   ("firstnumber" ,(number-to-string (1+ num-start))))
+			 org-e-latex-minted-options)))
+	      ;; Language.
+	      (or (cadr (assq (intern lang) org-e-latex-minted-langs)) lang)
+	      ;; Source code.
+	      (let* ((code-info (org-export-unravel-code src-block contents))
+		     (max-width
+		      (apply 'max
+			     (mapcar 'length
+				     (org-split-string (car code-info) "\n")))))
+		(org-export-format-code
+		 (car code-info)
+		 (lambda (loc num ref)
+		   (concat
+		    loc
+		    (when ref
+		      ;; Ensure references are flushed to the right,
+		      ;; separated with 6 spaces from the widest line
+		      ;; of code.
+		      (concat (make-string (+ (- max-width (length loc)) 6) ? )
+			      (format "(%s)" ref)))))
+		 nil (and retain-labels (cdr code-info)))))))
+	;; Return value.
 	(if float-env (format float-env body) body)))
-     ;; Use listings package.
+     ;; Case 4.  Use listings package.
      (t
       (let ((lst-lang
 	     (or (cadr (assq (intern lang) org-e-latex-listings-langs)) lang))
@@ -1719,14 +1752,39 @@ contextual information."
 		    "{[%s]%s}"
 		    (org-export-secondary-string (cdr caption) 'e-latex info)
 		    main))))))
-	(concat (format "\\lstset{%s}\n"
-			(org-e-latex--make-option-string
-			 (append org-e-latex-listings-options
-				 `(("language" ,lst-lang))
-				 (when label `(("label" ,label)))
-				 (when caption-str
-				   `(("caption" ,caption-str))))))
-		(format "\\begin{lstlisting}\n%s\\end{lstlisting}" code)))))))
+	(concat
+	 ;; Options.
+	 (format "\\lstset{%s}\n"
+		 (org-e-latex--make-option-string
+		  (append org-e-latex-listings-options
+			  `(("language" ,lst-lang))
+			  (when label `(("label" ,label)))
+			  (when caption-str `(("caption" ,caption-str)))
+			  (cond ((not num-start) '(("numbers" "none")))
+				((zerop num-start) '(("numbers" "left")))
+				(t `(("numbers" "left")
+				     ("firstnumber"
+				      ,(number-to-string (1+ num-start)))))))))
+	 ;; Source code.
+	 (format
+	  "\\begin{lstlisting}\n%s\\end{lstlisting}"
+	  (let* ((code-info (org-export-unravel-code src-block info))
+		 (max-width
+		  (apply 'max
+			 (mapcar 'length
+				 (org-split-string (car code-info) "\n")))))
+	    (org-export-format-code
+	     (car code-info)
+	     (lambda (loc num ref)
+	       (concat
+		loc
+		(when ref
+		  ;; Ensure references are flushed to the right,
+		  ;; separated with 6 spaces from the widest line of
+		  ;; code
+		  (concat (make-string (+ (- max-width (length loc)) 6) ? )
+			  (format "(%s)" ref)))))
+	     nil (and retain-labels (cdr code-info)))))))))))
 
 
 ;;;; Statistics Cookie

contrib/lisp/org-element.el

@@ -991,22 +991,43 @@ CONTENTS is nil."
 (defun org-element-example-block-parser ()
   "Parse an example block.
 
-Return a list whose car is `example' and cdr is a plist
-containing `:begin', `:end', `:options', `:hiddenp', `:value' and
-`:post-blank' keywords."
+Return a list whose car is `example-block' and cdr is a plist
+containing `:begin', `:end', `:number-lines', `:preserve-indent',
+`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
+`:switches', `:value' and `:post-blank' keywords."
   (save-excursion
     (end-of-line)
     (let* ((case-fold-search t)
 	   (switches (progn
 		       (re-search-backward
-			"^[ \t]*#\\+begin_example\\(?: +\\(.*\\)\\)?" nil t)
+			"^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?" nil t)
 		       (org-match-string-no-properties 1)))
+	   ;; Switches analysis
+	   (number-lines (cond ((not switches) nil)
+			       ((string-match "-n\\>" switches) 'new)
+			       ((string-match "+n\\>" switches) 'continued)))
+	   (preserve-indent (and switches (string-match "-i\\>" switches)))
+	   ;; Should labels be retained in (or stripped from) example
+	   ;; blocks?
+	   (retain-labels
+	    (or (not switches)
+		(not (string-match "-r\\>" switches))
+		(and number-lines (string-match "-k\\>" switches))))
+	   ;; What should code-references use - labels or
+	   ;; line-numbers?
+	   (use-labels
+	    (or (not switches)
+		(and retain-labels (not (string-match "-k\\>" switches)))))
+	   (label-fmt (and switches
+			     (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+			     (match-string 1 switches)))
+	   ;; Standard block parsing.
 	   (keywords (org-element-collect-affiliated-keywords))
 	   (begin (car keywords))
 	   (contents-begin (progn (forward-line) (point)))
 	   (hidden (org-truely-invisible-p))
 	   (contents-end (progn
-			   (re-search-forward "^[ \t]*#\\+end_example" nil t)
+			   (re-search-forward "^[ \t]*#\\+END_EXAMPLE" nil t)
 			   (point-at-bol)))
 	   (value (buffer-substring-no-properties contents-begin contents-end))
 	   (pos-before-blank (progn (forward-line) (point)))
@@ -1017,6 +1038,11 @@ containing `:begin', `:end', `:options', `:hiddenp', `:value' and
 		:end ,end
 		:value ,value
 		:switches ,switches
+		:number-lines ,number-lines
+		:preserve-indent ,preserve-indent
+		:retain-labels ,retain-labels
+		:use-labels ,use-labels
+		:label-fmt ,label-fmt
 		:hiddenp ,hidden
 		:post-blank ,(count-lines pos-before-blank end)
 		,@(cadr keywords))))))
@@ -1341,31 +1367,52 @@ CONTENTS is nil."
 
 Return a list whose car is `src-block' and cdr is a plist
 containing `:language', `:switches', `:parameters', `:begin',
-`:end', `:hiddenp', `:contents-begin', `:contents-end', `:value'
-and `:post-blank' keywords."
+`:end', `:hiddenp', `:contents-begin', `:contents-end',
+`:number-lines', `:retain-labels', `:use-labels', `:label-fmt',
+`:preserve-indent', `:value' and `:post-blank' keywords."
   (save-excursion
     (end-of-line)
     (let* ((case-fold-search t)
 	   ;; Get position at beginning of block.
 	   (contents-begin
 	    (re-search-backward
-	     (concat "^[ \t]*#\\+begin_src"
-		     "\\(?: +\\(\\S-+\\)\\)?"	     ; language
-		     "\\(\\(?: +[-+][A-Za-z]\\)*\\)" ; switches
-		     "\\(.*\\)[ \t]*$")		     ; arguments
+	     (concat
+	      "^[ \t]*#\\+BEGIN_SRC"
+	      "\\(?: +\\(\\S-+\\)\\)?"	; language
+	      "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)*\\)" ; switches
+	      "\\(.*\\)[ \t]*$")	; parameters
 	     nil t))
 	   ;; Get language as a string.
 	   (language (org-match-string-no-properties 1))
-	   ;; Get switches.
-	   (switches (org-match-string-no-properties 2))
 	   ;; Get parameters.
 	   (parameters (org-trim (org-match-string-no-properties 3)))
+	   ;; Get switches.
+	   (switches (org-match-string-no-properties 2))
+	   ;; Switches analysis
+	   (number-lines (cond ((not switches) nil)
+			       ((string-match "-n\\>" switches) 'new)
+			       ((string-match "+n\\>" switches) 'continued)))
+	   (preserve-indent (and switches (string-match "-i\\>" switches)))
+	   (label-fmt (and switches
+			     (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+			     (match-string 1 switches)))
+	   ;; Should labels be retained in (or stripped from) src
+	   ;; blocks?
+	   (retain-labels
+	    (or (not switches)
+		(not (string-match "-r\\>" switches))
+		(and number-lines (string-match "-k\\>" switches))))
+	   ;; What should code-references use - labels or
+	   ;; line-numbers?
+	   (use-labels
+	    (or (not switches)
+		(and retain-labels (not (string-match "-k\\>" switches)))))
 	   ;; Get affiliated keywords.
 	   (keywords (org-element-collect-affiliated-keywords))
 	   ;; Get beginning position.
 	   (begin (car keywords))
 	   ;; Get position at end of block.
-	   (contents-end (progn (re-search-forward "^[ \t]*#\\+end_src" nil t)
+	   (contents-end (progn (re-search-forward "^[ \t]*#\\+END_SRC" nil t)
 				(forward-line)
 				(point)))
 	   ;; Retrieve code.
@@ -1387,6 +1434,11 @@ and `:post-blank' keywords."
 		   :parameters ,parameters
 		   :begin ,begin
 		   :end ,end
+		   :number-lines ,number-lines
+		   :preserve-indent ,preserve-indent
+		   :retain-labels ,retain-labels
+		   :use-labels ,use-labels
+		   :label-fmt ,label-fmt
 		   :hiddenp ,hidden
 		   :value ,value
 		   :post-blank ,(count-lines contents-end end)

contrib/lisp/org-export.el

@@ -2801,30 +2801,24 @@ INFO is a plist used as a communication channel.
 Return associated line number in source code, or REF itself,
 depending on src-block or example element's switches."
   (org-element-map
-   (plist-get info :parse-tree) '(src-block example)
+   (plist-get info :parse-tree) '(example-block src-block)
    (lambda (el)
-     (let ((switches (or (org-element-property :switches el) "")))
-       (with-temp-buffer
-         (insert (org-trim (org-element-property :value el)))
-         ;; Build reference regexp.
-         (let* ((label
-                 (or (and (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
-                          (match-string 1 switches))
-                     org-coderef-label-format))
-                (ref-re
-                 (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$"
-                         (replace-regexp-in-string "%s" ref label nil t))))
-           ;; Element containing REF is found.  Only associate REF to
-           ;; a line number if element has "+n" or "-n" and "-k" or
-           ;; "-r" as switches.  When it has "+n", count accumulated
-           ;; locs before, too.
-           (when (re-search-backward ref-re nil t)
-             (cond
-              ((not (string-match "-[kr]\\>" switches)) ref)
-              ((string-match "-n\\>" switches) (line-number-at-pos))
-	      ((string-match "\\+n\\>" switches)
-	       (+ (org-export-get-loc el info) (line-number-at-pos)))
-              (t ref)))))))
+     (with-temp-buffer
+       (insert (org-trim (org-element-property :value el)))
+       (let* ((label-fmt (or (org-element-property :label-fmt el)
+			     org-coderef-label-format))
+	      (ref-re
+	       (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$"
+		       (regexp-quote
+			(replace-regexp-in-string "%s" ref label-fmt nil t)))))
+	 ;; Element containing REF is found.  Resolve it to either
+	 ;; a label or a line number, as needed.
+	 (when (re-search-backward ref-re nil t)
+	   (cond
+	    ((org-element-property :use-labels el) ref)
+	    ((eq (org-element-property :number-lines el) 'continued)
+	     (+ (org-export-get-loc el info) (line-number-at-pos)))
+	    (t (line-number-at-pos)))))))
    info 'first-match))
 
 
@@ -2933,8 +2927,21 @@ objects of the same type."
 ;; src-block or example-block elements with a "+n" switch until
 ;; a given element, excluded.  Note: "-n" switches reset that count.
 
-;; `org-export-handle-code' takes care of line numbering and reference
-;; cleaning in source code, when appropriate.
+;; `org-export-unravel-code' extracts source code (along with a code
+;; references alist) from an `element-block' or `src-block' type
+;; element.
+
+;; `org-export-format-code' applies a formatting function to each line
+;; of code, providing relative line number and code reference when
+;; appropriate.  Since it doesn't access the original element from
+;; which the source code is coming, it expects from the code calling
+;; it to know if lines should be numbered and if code references
+;; should appear.
+
+;; Eventually, `org-export-format-code-default' is a higher-level
+;; function (it makes use of the two previous functions) which handles
+;; line numbering and code references inclusion, and returns source
+;; code in a format suitable for plain text or verbatim output.
 
 (defun org-export-get-loc (element info)
   "Return accumulated lines of code up to ELEMENT.
@@ -2953,111 +2960,145 @@ ELEMENT is excluded from count."
         ;; Only count lines from src-block and example-block elements
         ;; with a "+n" or "-n" switch.  A "-n" switch resets counter.
         ((not (memq (org-element-type el) '(src-block example-block))) nil)
-        ((let ((switches (org-element-property :switches el)))
-           (when (and switches (string-match "\\([-+]\\)n\\>" switches))
+        ((let ((linums (org-element-property :number-lines el)))
+	   (when linums
 	     ;; Accumulate locs or reset them.
-	     (let ((accumulatep (string= (match-string 1 switches) "-"))
-		   (lines (org-count-lines
+	     (let ((lines (org-count-lines
 			   (org-trim (org-element-property :value el)))))
-	       (setq loc (if accumulatep lines (+ loc lines))))))
+	       (setq loc (if (eq linums 'new) lines (+ loc lines))))))
 	 ;; Return nil to stay in the loop.
          nil)))
      info 'first-match)
     ;; Return value.
     loc))
 
-(defun org-export-handle-code (element info &optional num-fmt ref-fmt delayed)
-  "Handle line numbers and code references in ELEMENT.
+(defun org-export-unravel-code (element info)
+  "Clean source code and extract references out of it.
 
 ELEMENT has either a `src-block' an `example-block' type.  INFO
 is a plist used as a communication channel.
 
-If optional argument NUM-FMT is a string, it will be used as
-a format string for numbers at beginning of each line.
-
-If optional argument REF-FMT is a string, it will be used as
-a format string for each line of code containing a reference.
-
-When optional argument DELAYED is non-nil, `org-loc' and
-`org-coderef' properties, set to an adequate value, are applied
-to, respectively, numbered lines and lines with a reference.  No
-line numbering is done and all references are stripped from the
-resulting string.  Both NUM-FMT and REF-FMT arguments are ignored
-in that situation.
-
-Return new code as a string."
-  (let* ((switches (or (org-element-property :switches element) ""))
-	 (code (org-element-property :value element))
-	 (numberp (string-match "[-+]n\\>" switches))
-	 (accumulatep (string-match "\\+n\\>" switches))
-	 ;; Initialize loc counter when any kind of numbering is
-	 ;; active.
-	 (total-LOC (cond
-		     (accumulatep (org-export-get-loc element info))
-		     (numberp 0)))
-	 ;; Get code and clean it.  Remove blank lines at its
-	 ;; beginning and end.  Also remove protective commas.
-	 (preserve-indent-p (or org-src-preserve-indentation
-				(string-match "-i\\>" switches)))
-	 (replace-labels (when (string-match "-r\\>" switches)
-			   (if (string-match "-k\\>" switches) 'keep t)))
+Return a cons cell whose CAR is the source code, cleaned from any
+reference and protective comma and CDR is an alist between
+relative line number (integer) and name of code reference on that
+line (string)."
+  (let* ((line 0) refs
+	 ;; Get code and clean it. Remove blank lines at its beginning
+	 ;; and end. Also remove protective commas.
 	 (code (let ((c (replace-regexp-in-string
 			 "\\`\\([ \t]*\n\\)+" ""
 			 (replace-regexp-in-string
-			  "\\(:?[ \t]*\n\\)*[ \t]*\\'" "\n" code))))
+			  "\\(:?[ \t]*\n\\)*[ \t]*\\'" "\n"
+			  (org-element-property :value element)))))
 		 ;; If appropriate, remove global indentation.
-		 (unless preserve-indent-p (setq c (org-remove-indentation c)))
+		 (unless (or org-src-preserve-indentation
+			     (org-element-property :preserve-indent element))
+		   (setq c (org-remove-indentation c)))
 		 ;; Free up the protected lines.  Note: Org blocks
 		 ;; have commas at the beginning or every line.
-		 (if (string=
-		      (or (org-element-property :language element) "")
-		      "org")
+		 (if (string= (org-element-property :language element) "org")
 		     (replace-regexp-in-string "^," "" c)
 		   (replace-regexp-in-string
 		    "^\\(,\\)\\(:?\\*\\|[ \t]*#\\+\\)" "" c nil nil 1))))
-	 ;; Split code to process it line by line.
-	 (code-lines (org-split-string code "\n"))
-	 ;; If numbering is active, ensure line numbers will be
-	 ;; correctly padded before applying the format string.
-	 (num-fmt
-	  (when (and (not delayed) numberp)
-	    (format (if (stringp num-fmt) num-fmt "%s:  ")
-		    (format "%%%ds"
-			    (length (number-to-string
-				     (+ (length code-lines) total-LOC)))))))
 	 ;; Get format used for references.
-	 (label-fmt (or (and (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
-			     (match-string 1 switches))
-			org-coderef-label-format))
+	 (label-fmt (or (org-element-property :label-fmt element)
+			  org-coderef-label-format))
 	 ;; Build a regexp matching a loc with a reference.
-	 (with-ref-re (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$"
-			      (replace-regexp-in-string
-			       "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t))))
+	 (with-ref-re
+	  (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)[ \t]*\\)$"
+		  (regexp-quote
+		   (replace-regexp-in-string
+		    "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t)))))
+    ;; Return value.
+    (cons
+     ;; Code with references removed.
+     (org-element-normalize-string
+      (mapconcat
+       (lambda (loc)
+	 (incf line)
+	 (if (not (string-match with-ref-re loc)) loc
+	   ;; Ref line: remove ref, and signal its position in REFS.
+	   (push (cons line (match-string 3 loc)) refs)
+	   (replace-match "" nil nil loc 1)))
+       (org-split-string code "\n") "\n"))
+     ;; Reference alist.
+     refs)))
+
+(defun org-export-format-code (code fun &optional num-lines ref-alist)
+  "Format CODE by applying FUN line-wise and return it.
+
+CODE is a string representing the code to format.  FUN is
+a function.  It must accept three arguments: a line of
+code (string), the current line number (integer) or nil and the
+reference associated to the current line (string) or nil.
+
+Optional argument NUM-LINES can be an integer representing the
+number of code lines accumulated until the current code.  Line
+numbers passed to FUN will take it into account.  If it is nil,
+FUN's second argument will always be nil.  This number can be
+obtained with `org-export-get-loc' function.
+
+Optional argument REF-ALIST can be an alist between relative line
+number (i.e. ignoring NUM-LINES) and the name of the code
+reference on it.  If it is nil, FUN's third argument will always
+be nil.  It can be obtained through the use of
+`org-export-unravel-code' function."
+  (let ((--locs (org-split-string code "\n"))
+	(--line 0))
     (org-element-normalize-string
      (mapconcat
-      (lambda (loc)
-	;; Maybe add line number to current line of code (LOC).
-	(when numberp
-	  (incf total-LOC)
-	  (setq loc (if delayed (org-add-props loc nil 'org-loc total-LOC)
-		      (concat (format num-fmt total-LOC) loc))))
-	;; Take action if at a ref line.
-	(when (string-match with-ref-re loc)
-	  (let ((ref (match-string 3 loc)))
-	    (setq loc
-		  ;; Option "-r" without "-k" removes labels.
-		  ;; A non-nil DELAYED removes labels unconditionally.
-		  (if (or delayed
-			  (and replace-labels (not (eq replace-labels 'keep))))
-		      (replace-match "" nil nil loc 1)
-		    (replace-match (format "(%s)" ref) nil nil loc 2)))
-	    ;; Store REF in `org-coderef' property if DELAYED asks to.
-	    (cond (delayed (setq loc (org-add-props loc nil 'org-coderef ref)))
-		  ;; If REF-FMT is defined, apply it to current LOC.
-		  ((stringp ref-fmt) (setq loc (format ref-fmt loc))))))
-	;; Return updated LOC for concatenation.
-	loc)
-      code-lines "\n"))))
+      (lambda (--loc)
+	(incf --line)
+	(let ((--ref (cdr (assq --line ref-alist))))
+	  (funcall fun --loc (and num-lines (+ num-lines --line)) --ref)))
+      --locs "\n"))))
+
+(defun org-export-format-code-default (element info)
+  "Return source code from ELEMENT, formatted in a standard way.
+
+ELEMENT is either a `src-block' or `example-block' element.  INFO
+is a plist used as a communication channel.
+
+This function takes care of line numbering and code references
+inclusion.  Line numbers, when applicable, appear at the
+beginning of the line, separated from the code by two white
+spaces.  Code references, on the other hand, appear flushed to
+the right, separated by six white spaces from the widest line of
+code."
+  ;; Extract code and references.
+  (let* ((code-info (org-export-unravel-code element info))
+         (code (car code-info))
+         (code-lines (org-split-string code "\n"))
+	 (refs (and (org-element-property :retain-labels element)
+		    (cdr code-info)))
+         ;; Handle line numbering.
+         (num-start (case (org-element-property :number-lines element)
+                      (continued (org-export-get-loc element info))
+                      (new 0)))
+         (num-fmt
+          (and num-start
+               (format "%%%ds  "
+                       (length (number-to-string
+                                (+ (length code-lines) num-start))))))
+         ;; Prepare references display, if required.  Any reference
+         ;; should start six columns after the widest line of code,
+         ;; wrapped with parenthesis.
+	 (max-width
+	  (+ (apply 'max (mapcar 'length code-lines))
+	     (if (not num-start) 0 (length (format num-fmt num-start))))))
+    (org-export-format-code
+     code
+     (lambda (loc line-num ref)
+       (let ((number-str (and num-fmt (format num-fmt line-num))))
+         (concat
+          number-str
+          loc
+          (and ref
+               (concat (make-string
+                        (- (+ 6 max-width)
+                           (+ (length loc) (length number-str))) ? )
+                       (format "(%s)" ref))))))
+     num-start refs)))
 
 
 ;;;; For Tables

testing/lisp/test-org-element.el

@@ -29,6 +29,7 @@
 ;;; Tests:
 
 
+
 ;;;; Headlines
 
 (ert-deftest test-org-element/headline-quote-keyword ()
@@ -99,6 +100,109 @@
 	(should (equal (org-element-property :tags headline) ":test:"))))))
 
 
+
+;;;; Example-blocks and Src-blocks
+
+(ert-deftest test-org-element/block-switches ()
+  "Test `example-block' and `src-block' switches parsing."
+  (let ((org-coderef-label-format "(ref:%s)"))
+    ;; 1. Test "-i" switch.
+    (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n(+ 1 1)\n#+END_SRC"
+      (let ((element (org-element-current-element)))
+	(should-not (org-element-property :preserve-indent element))))
+    (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp -i\n(+ 1 1)\n#+END_SRC"
+      (let ((element (org-element-current-element)))
+	(should (org-element-property :preserve-indent element))))
+    (org-test-with-temp-text "#+BEGIN_EXAMPLE\nText.\n#+END_EXAMPLE"
+      (let ((element (org-element-current-element)))
+	(should-not (org-element-property :preserve-indent element))))
+    (org-test-with-temp-text "#+BEGIN_EXAMPLE -i\nText.\n#+END_EXAMPLE"
+      (let ((element (org-element-current-element)))
+	(should (org-element-property :preserve-indent element))))
+    ;; 2. "-n -r -k" combination should number lines, retain labels but
+    ;;    not use them in coderefs.
+    (org-test-with-temp-text "#+BEGIN_EXAMPLE -n -r -k\nText.\N#+END_EXAMPLE"
+      (let ((element (org-element-current-element)))
+	(should (and (org-element-property :number-lines element)
+		     (org-element-property :retain-labels element)
+		     (not (org-element-property :use-labels element))))))
+    (org-test-with-temp-text
+	"#+BEGIN_SRC emacs-lisp -n -r -k\n(+ 1 1)\n#+END_SRC"
+      (let ((element (org-element-current-element)))
+	(should (and (org-element-property :number-lines element)
+		     (org-element-property :retain-labels element)
+		     (not (org-element-property :use-labels element))))))
+    ;; 3. "-n -r" combination should number-lines remove labels and not
+    ;;    use them in coderefs.
+    (org-test-with-temp-text "#+BEGIN_EXAMPLE -n -r\nText.\n#+END_EXAMPLE"
+      (let ((element (org-element-current-element)))
+	(should (and (org-element-property :number-lines element)
+		     (not (org-element-property :retain-labels element))
+		     (not (org-element-property :use-labels element))))))
+    (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp -n -r\n(+ 1 1)\n#+END_SRC"
+      (let ((element (org-element-current-element)))
+	(should (and (org-element-property :number-lines element)
+		     (not (org-element-property :retain-labels element))
+		     (not (org-element-property :use-labels element))))))
+    ;; 4. "-n" or "+n" should number lines, retain labels and use them
+    ;;    in coderefs.
+    (org-test-with-temp-text "#+BEGIN_EXAMPLE -n\nText.\n#+END_EXAMPLE"
+      (let ((element (org-element-current-element)))
+	(should (and (org-element-property :number-lines element)
+		     (org-element-property :retain-labels element)
+		     (org-element-property :use-labels element)))))
+    (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp -n\n(+ 1 1)\n#+END_SRC"
+      (let ((element (org-element-current-element)))
+	(should (and (org-element-property :number-lines element)
+		     (org-element-property :retain-labels element)
+		     (org-element-property :use-labels element)))))
+    (org-test-with-temp-text "#+BEGIN_EXAMPLE +n\nText.\n#+END_EXAMPLE"
+      (let ((element (org-element-current-element)))
+	(should (and (org-element-property :number-lines element)
+		     (org-element-property :retain-labels element)
+		     (org-element-property :use-labels element)))))
+    (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp +n\n(+ 1 1)\n#+END_SRC"
+      (let ((element (org-element-current-element)))
+	(should (and (org-element-property :number-lines element)
+		     (org-element-property :retain-labels element)
+		     (org-element-property :use-labels element)))))
+    ;; 5. No switch should not number lines, but retain labels and use
+    ;;    them in coderefs.
+    (org-test-with-temp-text "#+BEGIN_EXAMPLE\nText.\n#+END_EXAMPLE"
+      (let ((element (org-element-current-element)))
+	(should (and (not (org-element-property :number-lines element))
+		     (org-element-property :retain-labels element)
+		     (org-element-property :use-labels element)))))
+    (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n(+ 1 1)\n#+END_SRC"
+      (let ((element (org-element-current-element)))
+	(should (and (not (org-element-property :number-lines element))
+		     (org-element-property :retain-labels element)
+		     (org-element-property :use-labels element)))))
+    ;; 6. "-r" switch only: do not number lines, remove labels, and
+    ;;    don't use labels in coderefs.
+    (org-test-with-temp-text "#+BEGIN_EXAMPLE -r\nText.\n#+END_EXAMPLE"
+      (let ((element (org-element-current-element)))
+	(should (and (not (org-element-property :number-lines element))
+		     (not (org-element-property :retain-labels element))
+		     (not (org-element-property :use-labels element))))))
+    (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp -r\n(+ 1 1)\n#+END_SRC"
+      (let ((element (org-element-current-element)))
+	(should (and (not (org-element-property :number-lines element))
+		     (not (org-element-property :retain-labels element))
+		     (not (org-element-property :use-labels element))))))
+    ;; 7. Recognize coderefs with user-defined syntax.
+    (org-test-with-temp-text
+	"#+BEGIN_EXAMPLE -l \"[ref:%s]\"\nText [ref:text]\n#+END_EXAMPLE"
+      (let ((element (org-element-current-element)))
+	(should
+	 (equal (org-element-property :coderef-fmt element) "[ref:%s]"))))
+    (org-test-with-temp-text
+	"#+BEGIN_SRC emacs-lisp -l \"[ref:%s]\"\n(+ 1 1) [ref:text]\n#+END_SRC"
+      (let ((element (org-element-current-element)))
+	(should
+	 (equal (org-element-property :coderef-fmt element) "[ref:%s]"))))))
+
+
 
 ;;; Navigation tools.
 
@@ -312,7 +416,7 @@ Outside."
     (org-element-up)
     (should (looking-at "\\* Top"))))
 
-(ert-deftest test-org-elemnet/down-element ()
+(ert-deftest test-org-element/down-element ()
   "Test `org-element-down' specifications."
   ;; 1. Error when the element hasn't got a recursive type.
   (org-test-with-temp-text "Paragraph."

testing/lisp/test-org-export.el

@@ -470,3 +470,101 @@ body\n")))
 	       (lambda (link)
 		 (org-export-get-ordinal
 		  (org-export-resolve-fuzzy-link link info) info)) info t))))))
+
+(defun test-org-export/resolve-coderef ()
+  "Test `org-export-resolve-coderef' specifications."
+  (let ((org-coderef-label-format "(ref:%s)"))
+    ;; 1. A link to a "-n -k -r" block returns line number.
+    (org-test-with-temp-text
+	"#+BEGIN_EXAMPLE -n -k -r\nText (ref:coderef)\n#+END_EXAMPLE"
+      (let ((tree (org-element-parse-buffer)))
+	(should
+	 (= (org-export-resolve-coderef "coderef" `(:parse-tree ,tree)) 1))))
+    (org-test-with-temp-text
+	"#+BEGIN_SRC emacs-lisp -n -k -r\n(+ 1 1) (ref:coderef)\n#+END_SRC"
+      (let ((tree (org-element-parse-buffer)))
+	(should
+	 (= (org-export-resolve-coderef "coderef" `(:parse-tree ,tree)) 1))))
+    ;; 2. A link to a "-n -r" block returns line number.
+    (org-test-with-temp-text
+	"#+BEGIN_EXAMPLE -n -r\nText (ref:coderef)\n#+END_EXAMPLE"
+      (let ((tree (org-element-parse-buffer)))
+	(should
+	 (= (org-export-resolve-coderef "coderef" `(:parse-tree ,tree)) 1))))
+    (org-test-with-temp-text
+	"#+BEGIN_SRC emacs-lisp -n -r\n(+ 1 1) (ref:coderef)\n#+END_SRC"
+      (let ((tree (org-element-parse-buffer)))
+	(should
+	 (= (org-export-resolve-coderef "coderef" `(:parse-tree ,tree)) 1))))
+    ;; 3. A link to a "-n" block returns coderef.
+    (org-test-with-temp-text
+	"#+BEGIN_SRC emacs-lisp -n\n(+ 1 1) (ref:coderef)\n#+END_SRC"
+      (let ((tree (org-element-parse-buffer)))
+	(should
+	 (equal (org-export-resolve-coderef "coderef" `(:parse-tree ,tree))
+		"coderef"))))
+    (org-test-with-temp-text
+	"#+BEGIN_EXAMPLE -n\nText (ref:coderef)\n#+END_EXAMPLE"
+      (let ((tree (org-element-parse-buffer)))
+	(should
+	 (equal (org-export-resolve-coderef "coderef" `(:parse-tree ,tree))
+		"coderef"))))
+    ;; 4. A link to a "-r" block returns line number.
+    (org-test-with-temp-text
+	"#+BEGIN_SRC emacs-lisp -r\n(+ 1 1) (ref:coderef)\n#+END_SRC"
+      (let ((tree (org-element-parse-buffer)))
+	(should
+	 (= (org-export-resolve-coderef "coderef" `(:parse-tree ,tree)) 1))))
+    (org-test-with-temp-text
+	"#+BEGIN_EXAMPLE -r\nText (ref:coderef)\n#+END_EXAMPLE"
+      (let ((tree (org-element-parse-buffer)))
+	(should
+	 (= (org-export-resolve-coderef "coderef" `(:parse-tree ,tree)) 1))))
+    ;; 5. A link to a block without a switch returns coderef.
+    (org-test-with-temp-text
+	"#+BEGIN_SRC emacs-lisp\n(+ 1 1) (ref:coderef)\n#+END_SRC"
+      (let ((tree (org-element-parse-buffer)))
+	(should
+	 (equal (org-export-resolve-coderef "coderef" `(:parse-tree ,tree))
+		"coderef"))))
+    (org-test-with-temp-text
+	"#+BEGIN_EXAMPLE\nText (ref:coderef)\n#+END_EXAMPLE"
+      (let ((tree (org-element-parse-buffer)))
+	(should
+	 (equal (org-export-resolve-coderef "coderef" `(:parse-tree ,tree))
+		"coderef"))))
+    ;; 6. Correctly handle continued line numbers.  A "+n" switch
+    ;;    should resume numbering from previous block with numbered
+    ;;    lines, ignoring blocks not numbering lines in the process.
+    ;;    A "-n" switch resets count.
+    (org-test-with-temp-text "
+#+BEGIN_EXAMPLE -n
+Text.
+#+END_EXAMPLE
+
+#+BEGIN_SRC emacs-lisp
+\(- 1 1)
+#+END_SRC
+
+#+BEGIN_SRC emacs-lisp +n -r
+\(+ 1 1) (ref:addition)
+#+END_SRC
+
+#+BEGIN_EXAMPLE -n -r
+Another text. (ref:text)
+#+END_EXAMPLE"
+      (let* ((tree (org-element-parse-buffer))
+	     (info `(:parse-tree ,tree)))
+	(should (= (org-export-resolve-coderef "addition" info) 2))
+	(should (= (org-export-resolve-coderef "text" info) 1))))
+    ;; 7. Recognize coderef with user-specified syntax.
+    (org-test-with-temp-text
+	"#+BEGIN_EXAMPLE -l \"[ref:%s]\"\nText. [ref:text]\n#+END_EXAMPLE"
+      (let ((tree (org-element-parse-buffer)))
+	(should (equal (org-export-resolve-coderef "text" `(:parse-tree ,tree))
+		       "text"))))))
+
+
+
+(provide 'test-org-export)
+;;; test-org-export.el end here