Browse Source

source blocks can now find their results

  litorgy-where-is-src-block-result
Eric Schulte 16 years ago
parent
commit
3ccf6b8d6e
2 changed files with 73 additions and 42 deletions
  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)
     (litorgy-eval-buffer)
     (widen)))
     (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 ()
 (defun litorgy-get-src-block-info ()
   "Return the information of the current source block as a list
   "Return the information of the current source block as a list
 of the following form.  (language body header-arguments-alist)"
 of the following form.  (language body header-arguments-alist)"
   (let ((case-fold-search t) head)
   (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))
         (save-excursion (goto-char head) (litorgy-parse-src-block-match))
       (if (save-excursion ;; inline source block
       (if (save-excursion ;; inline source block
             (re-search-backward "[ \f\t\n\r\v]" nil t)
             (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)
           (litorgy-parse-inline-src-block-match)
         nil)))) ;; indicate that no source block was found
         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 ()
 (defun litorgy-parse-src-block-match ()
   (list (litorgy-clean-text-properties (match-string 1))
   (list (litorgy-clean-text-properties (match-string 1))
         (litorgy-clean-text-properties (match-string 4))
         (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))))
                            (cons (intern (concat ":" (match-string 1 arg))) (match-string 2 arg))))
          (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t))))
          (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)
 (defun litorgy-insert-result (result &optional insert)
   "Insert RESULT into the current buffer after the end of the
   "Insert RESULT into the current buffer after the end of the
 current source block.  With optional argument INSERT controls
 current source block.  With optional argument INSERT controls
@@ -251,13 +278,6 @@ silent -- no results are inserted"
 relies on `litorgy-insert-result'."
 relies on `litorgy-insert-result'."
   (with-temp-buffer (litorgy-insert-result result) (buffer-string)))
   (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)
 (defun litorgy-remove-result (&optional table)
   "Remove the result following the current source block.  If
   "Remove the result following the current source block.  If
 optional argument TABLE is supplied then remove the table
 optional argument TABLE is supplied then remove the table

+ 14 - 3
rorg.org

@@ -3,7 +3,7 @@
 #+SEQ_TODO:  TODO PROPOSED | DONE DEFERRED REJECTED
 #+SEQ_TODO:  TODO PROPOSED | DONE DEFERRED REJECTED
 #+STARTUP: oddeven
 #+STARTUP: oddeven
 
 
-* Tasks [12/19]
+* Tasks [13/20]
 ** TODO resolve references to other buffers
 ** TODO resolve references to other buffers
    This would allow source blocks to call upon tables, source-blocks,
    This would allow source blocks to call upon tables, source-blocks,
    and results in other buffers.
    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-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]]
    - [[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
    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
    force scalar or vector results.  This could be done with a header
    argument, and the default behavior could be controlled through a
    argument, and the default behavior could be controlled through a
    configuration variable.
    configuration variable.
 
 
-*** TODO results name
+** TODO results name
     In order to do this we will need to start naming our results.
     In order to do this we will need to start naming our results.
     Since the source blocks are named with =#+srcname:= lines we can
     Since the source blocks are named with =#+srcname:= lines we can
     name results with =#+resname:= lines (if the source block has no
     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
     source blocks to be located in different places in a buffer (and
     eventually in different buffers entirely).
     eventually in different buffers entirely).
 
 
+#+srcname: developing-resnames
 #+begin_src emacs-lisp 
 #+begin_src emacs-lisp 
 'schulte
 'schulte
 #+end_src
 #+end_src
 
 
 #+resname:
 #+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
 ** TODO re-implement R evaluation using ess-command or ess-execute
    I don't have any complaints with the current R evaluation code or
    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
    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
 * Buffer Dictionary
  LocalWords:  DBlocks dblocks litorgy el eric litorgical fontification
  LocalWords:  DBlocks dblocks litorgy el eric litorgical fontification
+
+
+