浏览代码

source blocks can now find their results

  litorgy-where-is-src-block-result
Eric Schulte 16 年之前
父节点
当前提交
3ccf6b8d6e
共有 2 个文件被更改,包括 73 次插入42 次删除
  1. 59 39
      litorgy/litorgy.el
  2. 14 3
      rorg.org

+ 59 - 39
litorgy/litorgy.el

@@ -141,34 +141,20 @@ 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-name ()
+  "Return the name of the current source block if one exists"
+  (let ((case-fold-search t))
+    (save-excursion
+      (goto-char (litorgy-where-is-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-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) head)
-    (if (setq head (litorgy-goto-src-block-head))
+    (if (setq head (litorgy-where-is-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)
@@ -177,15 +163,6 @@ 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))
@@ -205,6 +182,56 @@ of the following form.  (language body header-arguments-alist)"
                            (cons (intern (concat ":" (match-string 1 arg))) (match-string 2 arg))))
          (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t))))
 
+(defun litorgy-where-is-src-block-head ()
+  "Return 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-find-named-result (name)
+  "Return the location of the result named NAME in the current
+buffer or nil if no such result exists."
+  (save-excursion
+    (goto-char (point-min))
+    (when (re-search-forward (concat "#\\+resname:[ \t]*" (regexp-quote name)) nil t)
+      (move-beginning-of-line 1) (point))))
+
+(defun litorgy-where-is-src-block-result ()
+  "Return the point at the beginning of the result of the current
+source block.  Specifically at the beginning of the #+RESNAME:
+line.  If no result exists for this block then create a
+#+RESNAME: line following the source block."
+  (save-excursion
+    (goto-char (litorgy-where-is-src-block-head))
+    (let ((name (litorgy-get-src-block-name)) end head)
+      (or (and name (message name) (litorgy-find-named-result name))
+          (and (re-search-forward "#\\+end_src" nil t)
+               (progn (move-end-of-line 1) (forward-char 1) (setq end (point))
+                      (or (progn ;; either an unnamed #+resname: line already exists
+                            (re-search-forward "[^ \f\t\n\r\v]" nil t)
+                            (move-beginning-of-line 1) (looking-at "#\\+resname:"))
+                          (progn ;; or we need to back up and make one ourselves
+                            (goto-char end) (open-line 3) (forward-char 1)
+                            (insert "#+resname:") (move-beginning-of-line 1) t)))
+               (point))))))
+
 (defun litorgy-insert-result (result &optional insert)
   "Insert RESULT into the current buffer after the end of the
 current source block.  With optional argument INSERT controls
@@ -251,13 +278,6 @@ 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

+ 14 - 3
rorg.org

@@ -3,7 +3,7 @@
 #+SEQ_TODO:  TODO PROPOSED | DONE DEFERRED REJECTED
 #+STARTUP: oddeven
 
-* Tasks [12/19]
+* Tasks [13/20]
 ** TODO resolve references to other buffers
    This would allow source blocks to call upon tables, source-blocks,
    and results in other buffers.
@@ -12,13 +12,13 @@
    - [[file:litorgy/litorgy-ref.el::TODO%20allow%20searching%20for%20names%20in%20other%20buffers][litorgy-ref.el:searching-in-other-buffers]]
    - [[file:litorgy/litorgy.el::defun%20litorgy%20find%20named%20result%20name][litorgy.el#litorgy-find-named-result]]
 
-** TODO results-type header (scalar/vector) [0/1]
+** 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.
 
-*** TODO results name
+** TODO results name
     In order to do this we will need to start naming our results.
     Since the source blocks are named with =#+srcname:= lines we can
     name results with =#+resname:= lines (if the source block has no
@@ -29,12 +29,20 @@
     source blocks to be located in different places in a buffer (and
     eventually in different buffers entirely).
 
+#+srcname: developing-resnames
 #+begin_src emacs-lisp 
 'schulte
 #+end_src
 
 #+resname:
 
+    Once source blocks are able to find their own =#+resname:= lines
+    we then need to...
+
+*** TODO change the results insertion functions to use these lines
+
+*** TODO teach references to resolve =#+resname= lines.
+
 ** 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
@@ -1793,3 +1801,6 @@ and probably has some advantages (and probably shortfalls).
 
 * Buffer Dictionary
  LocalWords:  DBlocks dblocks litorgy el eric litorgical fontification
+
+
+