diff --git a/litorgy/litorgy.el b/litorgy/litorgy.el index 90e020bc1..379337daf 100644 --- a/litorgy/litorgy.el +++ b/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 diff --git a/rorg.org b/rorg.org index 43772f732..481bfe16f 100644 --- a/rorg.org +++ b/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