added function to return the name of the current source block

litorgy/litorgy.el

@@ -26,7 +26,7 @@
 
 ;;; Commentary:
 
-;; See rorg.org in this directory for more information
+;; See rorg.org in the parent directory for more information
 
 ;;; Code:
 (require 'org)
@@ -141,26 +141,35 @@ the header arguments specified at the source code block."
     (litorgy-eval-buffer)
     (widen)))
 
+(defun litorgy-goto-src-block-head ()
+  "Position the point at the beginning of the current source
+block.  Specifically at the beginning of the #+BEGIN_SRC line.
+If the point is not on a source block then return nil."
+  (let ((initial (point)) top bottom)
+    (or
+     (save-excursion ;; on a #+srcname: line
+       (beginning-of-line 1)
+       (and (looking-at "#\\+srcname") (forward-line 1)
+            (looking-at litorgy-src-block-regexp)
+            (point)))
+     (save-excursion ;; on a #+begin_src line
+       (beginning-of-line 1)
+       (and (looking-at litorgy-src-block-regexp)
+            (point)))
+     (save-excursion ;; inside a src block
+       (and
+        (re-search-backward "#\\+begin_src" nil t) (setq top (point))
+        (re-search-forward "#\\+end_src" nil t) (setq bottom (point))
+        (< top initial) (< initial bottom)
+        (goto-char top) (looking-at litorgy-src-block-regexp)
+        (point))))))
+
 (defun litorgy-get-src-block-info ()
   "Return the information of the current source block as a list
 of the following form.  (language body header-arguments-alist)"
-  (let ((case-fold-search t)
-        top middle bottom)
-    (if (or
-         (save-excursion ;; on a #+srcname: line
-           (beginning-of-line 1)
-           (and (looking-at "#\\+srcname") (forward-line 1)
-                (looking-at litorgy-src-block-regexp)))
-         (save-excursion ;; on a #+begin_src line
-           (beginning-of-line 1) (looking-at litorgy-src-block-regexp))
-         (save-excursion ;; inside a src block
-           (and
-            (setq middle (point)) (re-search-backward "#\\+begin_src" nil t)
-            (setq top (point)) (re-search-forward "#\\+end_src" nil t)
-            (setq bottom (point))
-            (< top middle) (< middle bottom)
-            (goto-char top) (looking-at litorgy-src-block-regexp))))
-        (litorgy-parse-src-block-match)
+  (let ((case-fold-search t) head)
+    (if (setq head (litorgy-goto-src-block-head))
+        (save-excursion (goto-char head) (litorgy-parse-src-block-match))
       (if (save-excursion ;; inline source block
             (re-search-backward "[ \f\t\n\r\v]" nil t)
             (forward-char 1)
@@ -168,6 +177,15 @@ of the following form.  (language body header-arguments-alist)"
           (litorgy-parse-inline-src-block-match)
         nil)))) ;; indicate that no source block was found
 
+(defun litorgy-get-src-block-name ()
+  "Return the name of the current source block if one exists"
+  (let ((case-fold-search t))
+    (save-excursion
+      (goto-char (litorgy-goto-src-block-head))
+      (if (save-excursion (forward-line -1)
+                          (looking-at "#\\+srcname:[ \f\t\n\r\v]*\\([^ \f\t\n\r\v]+\\)"))
+          (litorgy-clean-text-properties (match-string 1))))))
+
 (defun litorgy-parse-src-block-match ()
   (list (litorgy-clean-text-properties (match-string 1))
         (litorgy-clean-text-properties (match-string 4))
@@ -233,6 +251,13 @@ silent -- no results are inserted"
 relies on `litorgy-insert-result'."
   (with-temp-buffer (litorgy-insert-result result) (buffer-string)))
 
+(defun litorgy-goto-result ()
+  "Assumes that the point is on or in a source block.  This
+functions will place the point at the beginning of the related
+result line, or if no such line exists it will create one
+immediately following the source block."
+  )
+
 (defun litorgy-remove-result (&optional table)
   "Remove the result following the current source block.  If
 optional argument TABLE is supplied then remove the table

rorg.org

@@ -5,11 +5,16 @@
 
 * Tasks [12/18]
 ** TODO results-type header (scalar/vector)
-In response to a point in Dan's email.  We should allow the user to
-force scalar or vector results.  This could be done with a header
-argument, and the default behavior could be controlled through a
-configuration variable.
-
+   In response to a point in Dan's email.  We should allow the user to
+   force scalar or vector results.  This could be done with a header
+   argument, and the default behavior could be controlled through a
+   configuration variable.
+
+   Since the source blocks are named with =#+srcname:= lines we can
+   name results with =#+resname:= lines (if the source block has no
+   name then no name is given to the =#+resname:= line on creation,
+   otherwise the name of the source block is used).
+   
 ** TODO re-implement R evaluation using ess-command or ess-execute
    I don't have any complaints with the current R evaluation code or
    behaviour, but I think it would be good to use the ESS functions
@@ -141,10 +146,13 @@ for quick tests
 #+tblname: quick-test
 | 1 | 2 | 3 |
 
+#+srcname: quick-test-src-blk
 #+begin_src R :var vec=quick-test
 mean(mean(vec))
 #+end_src
 
+: 2
+
 ** DEFERRED Rework Interaction with Running Processes [0/3]
 *** TODO ability to select which of multiple sessions is being used
     Increasingly it is looking like we're going to want to run all