diff --git a/contrib/lisp/org-R.el b/contrib/lisp/org-R.el deleted file mode 100644 index ba90403e4..000000000 --- a/contrib/lisp/org-R.el +++ /dev/null @@ -1,883 +0,0 @@ -;;; org-R.el --- Computing and data visualisation in Org-mode using R - -;; Copyright (C) 2009 -;; Free Software Foundation, Inc. - -;; Author: Dan Davison -;; Keywords: org, R, ESS, tables, graphics -;; Homepage: http://www.stats.ox.ac.uk/~davison/software/org-R -;; Version: 0.06 2009-04-15 -;; -;; This file is not part of GNU Emacs. -;; -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file allows R (http://www.r-project.org) code to be applied to -;; emacs org-mode (http://orgmode.org) tables. When the result of the -;; analysis is a vector or matrix, it is output back into the org-mode -;; buffer as a new org table. Alternatively the R code may be used to -;; plot the data in the org table. It requires R to be running in an -;; inferior-ess-mode buffer (install Emacs Speaks Statistics -;; http://ess.r-project.org and issue M-x R). -;; -;; -;; The user interface is via two different options lines in the org -;; buffer. As is conventional in org-mode, these are lines starting -;; with `#+'. Lines starting with #+R: specify options in the -;; standard org style (option:value) and are used to specify certain -;; off-the-shelf transformations and plots of the table data. The -;; #+R: line is also used to specify the data to be analysed -;; (either an org table or a csv file), and to restrict the analysis -;; to certain columns etc. In lines starting #+RR: you can supply -;; literal R code, giving you full control over what you do with the -;; table. With point in the first #+R line, M-x org-R-apply -;; makes happen whatever has been specified in those lines. - -;; The documentation is currently the Worg tutorial: -;; -;; http://orgmode.org/worg/org-tutorials/org-R/org-R.php -;; -;; changelog: -;; 2009-04-05 two bug fixes in org-R-eval contributed by David Moffat -;; 2009-05-15 added lwd argument to matplot because it doesn't respect global par settings -;; 2009-05-15 uncommented set-buffer to transit buffer in org-eval (why was it commented?) - -(defconst org-R-skeleton-funcall-1-arg - "%s(x[%s]%s)" - "Skeleton of a call to an R function. -E.g. barplot(x[,3:5], names.arg=rownames(x))") - -(defconst org-R-skeleton-funcall-2-args - "%s(x[,%s], x[,%s]%s)" - "Skeleton of a call to an R function which can take x and y - args.") - -(defconst org-R-write-org-table-def - "write.org.table <- function (x, write.rownames = TRUE) -{ - if(!is.null(dim(x)) && length(dim(x)) > 2) - stop(\"Object must be 1- or 2-dimensional\") ; - if(is.vector(x) || is.table(x) || is.factor(x) || is.array(x)) - x <- as.matrix(x) ; - if(!(is.matrix(x) || inherits(x, c('matrix', 'data.frame')))) { - invisible() ; - print(x) ; - stop(\"Object not recognised as 1- or 2-dimensional\") ; - } ; - if(is.null(colnames(x))) - colnames(x) <- rep('', ncol(x)) ; - if(write.rownames) - x <- cbind(rownames(x), x) ; - cat('|', paste(colnames(x), collapse = ' | '), '|\\n') ; - cat('|', paste(rep('----', ncol(x)), collapse = '+'), '|\\n', sep = '') ; - invisible(apply(x, 1, function(row) cat('|', paste(row, collapse = ' | '), '|\\n'))) ; -}" - "Definition of R function to write org table representation of R objects. -To see a more human-readable version of this, look at the code, -or type dput(write.org.table) RET at the R (inferior-ess-mode -buffer) prompt.") - -(defun org-R-apply-maybe () - (if (save-excursion - (beginning-of-line 1) - (looking-at "#\\+RR?:")) - (progn (call-interactively 'org-R-apply) - t) ;; to signal that we took action - nil)) ;; to signal that we did not - -(add-hook 'org-ctrl-c-ctrl-c-hook 'org-R-apply-maybe) - - -(defun org-R-apply () - "Construct and evaluate an R function call. -Construct an R function corresponding to the #+R: and #+RR: -lines. R must be currently running in an inferior-ess-mode -buffer. The function evaluates any user-supplied R code in the -#+RR: line before the off-the-shelf actions specified in the #+R: -line. The user-supplied R code can operate on a variable called x -that is the org table represented as a data frame in R. Text -output from the R process may be inserted into the org buffer, as -an org table where appropriate." - (interactive) - (require 'ess) - (save-excursion - (beginning-of-line) - (unless (looking-at "#\\+RR?:") (error "Point must be in a #+R or #+RR line")) - (while (looking-at "#\\+RR?:") (forward-line -1)) - (forward-line) - ;; For the rest of the code in this file we are based at the - ;; beginning of the first #+R line - - ;; FIXME: if point is at the beginning of the #+RR? lines when - ;; this function is called, then tabular output gets inserted, - ;; leaving point up at the top of the tabular output. - - (let* ((options (org-R-get-options)) - (code (org-R-construct-code options)) - (infile (plist-get options :infile)) - (ext (if infile (file-name-extension infile))) - csv-file) - - (if (string-equal ext "csv") - (setq csv-file infile) - (setq csv-file - (org-R-export-to-csv - (make-temp-file "org-R-tmp" nil ".csv") options))) - - (org-R-eval code csv-file options) - - (delete-other-windows) ;; FIXME - (if (plist-get options :showcode) (org-R-showcode code))))) - -(defun org-R-apply-throughout-subtree () - "Call org-R-apply in every org-R block in current subtree." - ;; This currently relies on re-search-forward leaving point after - ;; the #+RR?: If point were at the beginning of the line, then - ;; tabular input would get inserted leaving point above the #+RR?:, - ;; and this would loop infinitely. Same for org-R-apply-to-buffer. - (interactive) - (save-excursion - (org-back-to-heading) - (while (re-search-forward - "^#\\+RR?:" - (save-excursion (org-end-of-subtree)) t) - (org-R-apply) - (forward-line) - (while (looking-at "#\\+RR?") - (forward-line))))) - -(defun org-R-apply-throughout-buffer () - "Call org-R-apply in every org-R block in the buffer." - (interactive) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^#\\+RR?:" nil t) - (org-R-apply) - (forward-line) - (while (looking-at "#\\+RR?") - (forward-line))))) - -(defun org-R-construct-code (options) - "Construct the R function that implements the requested -behaviour. -The body of this function derives from two sources: - -1. Explicit R code which is read from lines starting with -#+RR: by org-R-get-user-code, and - -2. Off-the-shelf code corresponding to options specified in the -#+R: line. This code is constructed by -org-R-off-the-shelf-code." - (let ((user-code (org-R-get-user-code)) - (action (plist-get options :action))) - - (if (or (eq action 'tabulate) (eq action 'transpose)) - (setq options (plist-put options :output-to-buffer t))) - (format "function(x){%sx}" - (concat - (when user-code (concat user-code ";")) - (when action (concat (org-R-off-the-shelf-code options) ";")))))) - -(defun org-R-get-user-code (&optional R) - "Read user-supplied R code from #+RR: lines." - (let ((case-fold-search t)) - (save-excursion - (while (looking-at "^#\\+\\(RR?:\\) *\\(.*\\)") - (if (string= "RR:" (match-string 1)) - (setq R (concat R (when R ";") (match-string 2)))) - (forward-line)))) - R) - -(defun org-R-off-the-shelf-code (options) - "Return R code implementing the actions requested in the -#+R: lines." - - ;; This is a somewhat long function as it deals with several - ;; different cases, corresponding to all the off-the-shelf actions - ;; that have been implemented. - - (let* ((action (plist-get options :action)) - (cols (plist-get options :columns)) - (ncols (org-R-number-of-columns cols)) - (nxcols (nth 0 ncols)) - (nycols (nth 1 ncols)) - (cols-R (org-R-make-index-vectors cols)) - (xcols-R (nth 0 cols-R)) - (ycols-R (nth 1 cols-R)) - seq args largs extra-code title colour matrix-index) - - ;; I want this to affect options outside this function. Will it - ;; necessarily do so? (not if plist-put adds to head of the - ;; plist?) - (setq options (plist-put options :nxcols nxcols)) - - (cond ((eq action 'points) - (setq action 'plot) - (setq options (plist-put options :lines nil))) - ((eq action 'lines) - (setq action 'plot) - (setq options (plist-put options :lines t)))) - - (if (and (setq title (plist-get options :title)) (symbolp title)) - (setq title symbol-name title)) - - (setq args (plist-put args :main (concat "\"" title "\""))) - - (if (setq colour (or (plist-get options :colour) - (plist-get options :color) - (plist-get options :col))) - (setq args - (plist-put args :col - (concat "\"" (if (symbolp colour) (symbol-name colour) colour) "\"")))) - - (setq largs - (if (setq legend (plist-get options :legend)) - (plist-put largs :x - (concat "\"" (if (symbolp legend) (symbol-name legend) legend) "\"")) - (plist-put largs :x "\"topright\""))) - - (cond - ((null ycols-R) - ;; single set of columns; implicit x values - (if (null xcols-R) - (setq xcols-R "" matrix-index "") - (setq matrix-index (concat "," xcols-R))) - (cond - - ;;---------------------------------------------------------------------- - - ((eq action 'barplot) - (if (eq nxcols 1) - (progn - (setq args (plist-put args :names.arg "rownames(x)")) - (setq args (org-R-set-user-supplied-args args (plist-get options :args))) - (format org-R-skeleton-funcall-1-arg - "barplot" xcols-R - (concat ", " (org-R-plist-to-R-args args)))) - - (setq args (plist-put args :names.arg "colnames(x)")) - (setq args (plist-put args :col "seq(nrow(x))")) - (setq args (plist-put args :beside "TRUE")) - - (setq largs (plist-put largs :bty "\"n\"")) - ;; (setq largs (plist-put largs :lwd 10)) - (setq largs (plist-put largs :col "seq(nrow(x))")) - (setq largs (plist-put largs :legend "rownames(x)")) - - (setq args (org-R-set-user-supplied-args args (plist-get options :args))) - - (concat (format org-R-skeleton-funcall-1-arg - "barplot(as.matrix" matrix-index - (concat "), " (org-R-plist-to-R-args args))) - "; legend(" (org-R-plist-to-R-args largs) ")"))) - - ;;---------------------------------------------------------------------- - - ((eq action 'density) - (if (and nxcols (> nxcols 1)) - (error "Multiple columns not implemented for action:%s" action)) - - (setq args (plist-put args :xlab (concat "colnames(x)["xcols-R"]"))) - (setq args (org-R-set-user-supplied-args args (plist-get options :args))) - - (format org-R-skeleton-funcall-1-arg - "plot(density" matrix-index - (concat "), " (org-R-plist-to-R-args args)))) - - ;;---------------------------------------------------------------------- - - ((eq action 'hist) - (if (and nxcols (> nxcols 1)) - (error "Multiple columns not implemented for action:%s" action)) - (setq args (plist-put args :xlab (concat "colnames(x)["xcols-R"]"))) - (setq args (org-R-set-user-supplied-args args (plist-get options :args))) - (setq args (concat ", " (org-R-plist-to-R-args args))) - (format org-R-skeleton-funcall-1-arg "hist" matrix-index args)) - - ;;---------------------------------------------------------------------- - - ((eq action 'image) - (format org-R-skeleton-funcall-1-arg "image(as.matrix" matrix-index ")")) - - ;;---------------------------------------------------------------------- - - ((eq action 'plot) - (setq R-fun (if (eq nxcols 1) "plot" "matplot")) - (setq seq (concat "seq_along("xcols-R")")) - - (setq args (plist-put args :type (if (plist-get options :lines) "\"l\"" "\"p\""))) - (setq args (plist-put args :ylab (concat "colnames(x)["xcols-R"]"))) - (if (string-equal R-fun "matplot") - (setq args (plist-put args :lwd "par(\"lwd\")"))) - (setq args (concat ", " (org-R-plist-to-R-args args))) - - (concat - (format org-R-skeleton-funcall-1-arg R-fun matrix-index args) - extra-code)) - - ;;---------------------------------------------------------------------- - - ((eq action 'tabulate) - (concat - (if (plist-get options :sort) - (format org-R-skeleton-funcall-1-arg - "x <- sort(table" xcols-R "), decreasing=TRUE") - (format org-R-skeleton-funcall-1-arg "x <- table" matrix-index "")) - (if (eq nxcols 1) "; x <- data.frame(value=names(x), count=x[])"))) - - ;;---------------------------------------------------------------------- - - ((eq action 'transpose) - (format org-R-skeleton-funcall-1-arg "x <- t" matrix-index "")) - - ;;---------------------------------------------------------------------- - - ;; Don't recognise action: option, try applying it as the name of an R function. - - (t (format org-R-skeleton-funcall-1-arg - (concat "x <- " (symbol-name action)) matrix-index "")))) - - ;;---------------------------------------------------------------------- - - (ycols-R - ;; x and y columns specified - (cond - - ;;---------------------------------------------------------------------- - - ((eq action 'plot) - (unless (eq nxcols 1) (error "Multiple x-columns not implemented for action:plot")) - (setq R-fun (if (and (eq nxcols 1) (eq nycols 1)) "plot" "matplot")) - - (setq args - (plist-put - args :ylab - (concat "if(length("ycols-R") == 1) colnames(x)["ycols-R"] else ''"))) - (setq args (plist-put args :xlab (concat "colnames(x)["xcols-R"]"))) - (if (string-equal R-fun "matplot") ;; matplot doesn't respect par()$lwd - (setq args (plist-put args :lwd "par(\"lwd\")"))) - (setq args (plist-put args :type (if (plist-get options :lines) "\"l\"" "\"p\""))) - - (setq args (concat ", " (org-R-plist-to-R-args args))) - (setq seq (concat "seq_along("ycols-R")")) - - (setq largs (plist-put largs :col seq)) - (setq largs (plist-put largs :lty seq)) - (setq largs (plist-put largs :bty "\"n\"")) - (setq largs (plist-put largs :legend (concat "colnames(x)["ycols-R"]"))) - - (setq extra-code - (concat "; " - "if(length("ycols-R") > 1) " - "legend(" (org-R-plist-to-R-args largs) ")")) - - (concat - (format org-R-skeleton-funcall-2-args R-fun xcols-R ycols-R args) - extra-code)) - - ;;---------------------------------------------------------------------- - - (t (error "action:%s requires a single set of columns" (symbol-name action)))))))) - -(defun org-R-set-user-supplied-args (args user-args) - "Set user-supplied values in arguments plist." - (while (setq prop (pop user-args)) - (setq args (plist-put args prop (pop user-args)))) - args) - -(defun org-R-plist-to-R-args (plist) - "Convert a plist into a string of R arguments." - (let (arg-string arg) - (while (setq arg (pop plist)) - (string-match ":\\(\.*\\)" (symbol-name arg)) - (setq arg (match-string 1 (symbol-name arg))) - (setq arg-string - (concat - (if arg-string (concat arg-string ", ")) - (format "%s=%s" arg (pop plist))))) - arg-string)) - -(defun org-R-alist-to-R-args (alist) - "Convert an alist of (argument . val) pairs into a string of R arguments. -The alist is something like - '((arg1 . 1) - (arg2 . a)) -This isn't used, but it seems much nicer than -my plist equivalent. Is there a better way to write the plist -version? -" - (mapconcat - 'identity - (mapcar (lambda(pair) (format "%s = %s" (car pair) (cdr pair))) alist) - ", ")) - -(defun org-R-make-index-vectors (cols) - "Construct R indexing vectors as strings from lisp form. - -COLS is the lisp form given by the `columns:' option. It may -take the following forms: - -1. integer atom - the number of the column -2. symbol/string atom - the name of the column -3. list of length 1 - same as 1 or 2 above -4. list of length > 1 - specification of multiple columns as 1 or 2 above, unless it is -5. list of 2 lists - each list specifies (possibly multiple) columns - -In cases 1-4 this function returns a list of length 1, containing -the R index vector as a string. In case 5 this function returns a -list of two such index vectors. - -In cases 1 - 4, when a bivariate plot is requested such as by -`action:lines', the x values are implicit, i.e -1,2,...,number-of-rows. - -In case 4, an attempt is made to do something sensible with the -multiple columns, e.g. for `action:lines' they will be plotted -together on the same graph against the implicit x values, and for -`action:barplot' the bars corresponding to a single row will be -stacked on top of each other, or placed side by side, depending -on the value of the `beside' option. - -For `action:tabulate', if 2 columns are selected, a -two-dimensional table is created. If more than 2, then the -appropriately dimensioned table is computed and inserted using -the standard text representation of multi-dimensional arrays used -by R (as org does not currently have tables of dimension > 2). - -The straightforward case of case 5 is that both lists are of -length 1. For `action:plot' and `action:lines' these specify the -y and x coordinates of the points to be plotted or joined by -lines. - -The intention is that `org-R-apply' does something -corresponding to what would happen if you did the following in R: - -fun(x=tab[,xcols], y=tab[,ycols]) - -where fun is the R function implementing the desired -action (plotting/computation), tab is the org table, xcols are -the columns specified in cases 1-4 above, and ycols are the -second set of columns which might have been specified under case -5 above. For relevant R documentation see the help page -associated with the function xy.coords, e.g. by typing ?xy.coords -at the R prompt. - -The following won't work with case 5: `tabulate' -" - (defun org-R-make-index-vector (cols) - "Return the R indexing vector (as a string) corresponding to -the lisp form COLS. In this function, COLS is a either a list of -atoms, or an atom, i.e. in the form of cases 1-4" - (when cols - (let (to-stringf) - (unless (listp cols) (setq cols (list cols))) - (setq to-stringf - (cond ((car (mapcar 'symbolp cols)) - (lambda (symbol) (concat "\"" (symbol-name symbol) "\""))) - ((car (mapcar 'integerp cols)) - 'int-to-string) - ((car (mapcar 'stringp cols)) - (lambda (string) (concat "\"" string "\""))) - (t (error "Column selection should be symbol, integer or string: %S" cols)))) - (concat (when (> (length cols) 1) "c(") - (mapconcat to-stringf cols ",") - (when (> (length cols) 1) ")"))))) - - (if (and (listp cols) (listp (car cols))) - (mapcar 'org-R-make-index-vector cols) ;; case 5 - (list (org-R-make-index-vector cols)))) ;; other cases - -(defun org-R-number-of-columns (cols) - (defun f (c) (if (listp c) (length c) 1)) - (if (and (listp cols) (listp (car cols))) - (mapcar 'f cols) - (list (f cols)))) - - -(defun org-R-eval (R-function csv-file options) - "Apply an R function to tabular data and receive output as an org table. - -R-FUNCTION is a string; it may be simply the name of an -appropriate R function (e.g. \"summary\", \"plot\"), or a -user-defined anonymous function of the form -\"(function(data.frame) {...})\". It will receive as its first -argument the org table as an R 'data frame' -- a table-like -structure which can have columns containing different types of -data -- numeric, character etc. - -The R function may produce graphical and/or text output. If it -produces text output, and the replace:t is specified, and if -there is a table immediately above the #+R lines, then it is -replaced by the text output. Otherwise the text output is -inserted above the #+R lines. -" - (let ((transit-buffer "org-R-transit") - (infile (plist-get options :infile)) - (output-file (plist-get options :outfile)) - (title (plist-get options :title)) - output-format graphics-output-file width height) - - (unless (not output-file) - ;; We are writing output to file. Determine file format and - ;; location, and open graphics device if necessary. - (if (string-match - "\\(.*\.\\)?\\(org\\|png\\|jpg\\|jpeg\\|pdf\\|ps\\|bmp\\|tiff\\)$" - output-file) - (setq output-format (match-string 2 output-file)) - (error "Did not recognise file name suffix %s as available output format" - (match-string 2 output-file))) - (unless (match-string 1 output-file) - ;; only suffix provided: store in org-attach dir - (require 'org-attach) - (let ((temporary-file-directory (org-attach-dir t))) - (setq output-file - (make-temp-file - "org-R-output-" nil (concat "." output-format))))) - ;;; MdQ bug fix. - ;;; If a filename is given, make sure it's absolute, - ;;; as ess-execute needs that later. - (if (match-string 1 output-file) - (setq output-file (expand-file-name output-file)) ) - - (if (eq output-format "jpg") (setq output-format "jpeg")) - (setq graphics-output-file (not (string-equal output-format "org"))) - (if graphics-output-file ;; open the graphics device - (ess-execute - (concat output-format "(file=\"" output-file "\"" - (if (setq width (plist-get options :width)) - (format ", width=%d" width)) - (if (setq height (plist-get options :height)) - (format ", height=%d" height)) ")")))) - - ;; Apply R code to table (which is now stored as a csv file) - ;; does it matter whether this uses ess-command or ess-execute? - - ;; First evaluate function definition for R -> org table conversion - ;;; MdQ bug fix. - ;;; The following save-excursion has been brought up to here - ;;; so that the two ess-execute commands are now within it. - ;;; This is because they have the side effect of changing current - ;;; buffer to the transit-buffer, which causes error of deleting - ;;; the wrong table there, instead of in the org buffer. - (save-excursion - (ess-execute (replace-regexp-in-string "\n" " " org-R-write-org-table-def) - nil transit-buffer) - - ;; FIXME: why not eval the function def together with the function call - ;; as in the commented out line below (it didn't work for some reason) - (ess-execute - (concat - ;; (replace-regexp-in-string "\n" " " org-R-write-org-table-def) ";" - (org-R-make-expr R-function csv-file options)) nil transit-buffer) - - (set-buffer (concat "*" transit-buffer "*")) - (unless (or (looking-at "$") - (string-equal (buffer-substring-no-properties 1 2) "|")) - (error "Error in R evaluation:\n%s" (buffer-string)))) - - - (if csv-file - (unless (and infile - (string-equal (file-name-extension infile) "csv")) - (delete-file csv-file))) - - (if graphics-output-file (ess-execute "dev.off()")) ;; Close graphics device - - (unless (or graphics-output-file - (not (plist-get options :output-to-buffer))) - ;; Send tabular output to a org buffer as new org - ;; table. Recall that we are currently at the beginning of the - ;; first #+R line - (if (and output-file graphics-output-file) - (error "output-to-buffer and graphics-output-file both t")) - - (save-excursion - (if output-file - (progn (set-buffer (find-file-noselect output-file)) - (delete-region (point-min) (point-max))) - (if (plist-get options :replace) - (progn ;; kill a table iff in one or one ends on the previous line - (delete-region (org-table-begin) (org-table-end)) - (save-excursion - (forward-line -1) - (if (looking-at "#\\+TBLNAME") - (delete-region (point) (1+ (point-at-eol)))))))) - (if title (insert "#+TBLNAME:" title "\n")) - (insert-buffer-substring (concat "*" transit-buffer "*")) - (org-table-align) - (if output-file (save-buffer)))) - - ;; We might be linking to graphical output, or to org output in - ;; another file. Either way, point is still at the beginning of - ;; the first #+R line. - (unless (not output-file) - (save-excursion - (forward-line -1) - (if (looking-at "\\[\\[file:") - (delete-region (point) (1+ (point-at-eol))))) - (insert (org-make-link-string - (concat "file:" output-file) - (unless (plist-get options :inline) - (or title (concat output-format " output")))) "\n")) - - (kill-buffer (concat "*" transit-buffer "*")))) - - -(defun org-R-export-to-csv (csv-file options) - "Find and export org table to csv. - -If the intable: option has not been supplied, then the table must -end on the line immediately above the #+R lines. Otherwise, -the remote table referenced by the intable: option is found using -org-R-find-table. If options:infile has been set then this is the -org file containing the table. See the docstring of -org-R-find-table for details." - (let ((tbl-name-or-id (plist-get options :intable)) - (org-file (plist-get options :infile)) tbl-marker) - - (if (and org-file - (not (string-equal (file-name-extension org-file) "org"))) - (error "File %s extension is not .csv so should be .org")) - - (save-excursion - (if tbl-name-or-id - ;; a remote table has been specified -- move into it - (progn - (if org-file (set-buffer (find-file-noselect org-file))) - (setq tbl-marker (org-R-find-table tbl-name-or-id 'marker)) - (set-buffer (marker-buffer tbl-marker)) - (goto-char (marker-position tbl-marker))) - (forward-line -1)) ;; move into table above - (if (looking-at "[ \t]*|") - (progn (org-table-export csv-file "orgtbl-to-csv") csv-file) - nil)))) - -(defun org-R-find-table (name-or-id &optional markerp) - "Return location of a table. - -NAME-OR-ID may be the name of a -table in the current file as set by a \"#+TBLNAME:\" directive. -The first table following this line will then be used. -Alternatively, it may be an ID referring to any entry, perhaps in -a different file. In this case, the first table in that entry -will be referenced. The location is returned as a marker pointing -to the beginning of the first line of the table. - -This is taken from the first part of org-table-get-remote-range -in org-table.el. -" - (cond - ((symbolp name-or-id) (setq name-or-id (symbol-name name-or-id))) - ((numberp name-or-id) (setq name-or-id (number-to-string name-or-id)))) - (save-match-data - (let ((id-loc nil) (case-fold-search t) buffer loc) - (save-excursion - (save-restriction - (widen) - (save-excursion - (goto-char (point-min)) - (if (re-search-forward - (concat "^#\\+TBLNAME:[ \t]*" (regexp-quote name-or-id) "[ \t]*$") - nil t) - ;; OK, we've found a matching table name in this buffer. - (setq buffer (current-buffer) loc (match-beginning 0)) - ;; It's not a table name in this buffer. It must be an entry id. - ;; obtain a marker pointing to it. - (setq id-loc (org-id-find name-or-id 'marker) - buffer (marker-buffer id-loc) - loc (marker-position id-loc)) - (move-marker id-loc nil))) ;; disable the marker - ;; (switch-to-buffer buffer) - (set-buffer buffer) - ;; OK, so now we're in the right buffer, and loc is either - ;; the beginning of the #+TBLNAME line, or the location of the entry - ;; either way we need to search forward to get to the beginning of the table - (save-excursion - (save-restriction - (widen) - (goto-char loc) - (forward-char 1) - ;; The following regexp search finds the beginning of - ;; the next table in this entry. If it gets to the next - ;; entry before the next table, then it signals failure. - (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) - (not (match-beginning 1))) - (error "Cannot find a table at NAME or ID %s" name-or-id)) - (if markerp - (move-marker (make-marker) (point-at-bol) (current-buffer)) - (error "Option to return cons cell not implemented. - It should return (file-name . position) to be - consistent with functions in org-id.el"))))))))) - -(defun org-R-make-expr (R-function csv-file options) - "Construct R code to read data, analyse it and write output." - - (let ((rownames (plist-get options :rownames)) - (colnames (plist-get options :colnames)) - (action (plist-get options :action)) - (replace (plist-get options :replace))) - - (if (and csv-file (symbolp csv-file)) - (setq csv-file (symbol-name csv-file))) - - (format "write.org.table((%s)(%s), write.rownames=%s)" - R-function - (if csv-file - (format - "read.csv(\"%s\", header=%s, row.names=%s)" - csv-file - - ;; Do we treat first row as colnames? Yes by default - ;; FIXME: should really check for hline - (if colnames "TRUE" "FALSE") - - ;; Do we use a column as rownames? Not unless rownames: is specified - (if rownames "1" "NULL")) - "NULL") - - ;; Do we write rownames into org table? - (cond ((eq action 'tabulate) - (if (eq (plist-get options :nxcols) 1) "FALSE" "TRUE")) - ((eq action 'transpose) (if colnames "TRUE" "FALSE")) - (rownames "TRUE") - (t "TRUE"))))) - -(defun org-R-get-options () - "Parse the #+R: lines and return the options and values as a p-list." - (let ((opts '( - (:infile . "infile") - (:intable . "intable") - (:rownames . "rownames") - (:colnames . "colnames") - (:columns . "columns") - - (:action . "action") - (:args . "args") - - (:outfile . "outfile") - (:replace . "replace") - (:title . "title") - (:legend . "legend") - (:colour . "colour") - (:color . "color") - (:col . "col") - (:height . "height") - (:width . "width") - (:lines . "lines") - (:sort . "sort") - (:inline . "inline") - - (:output-to-buffer . "output-to-buffer") - - (:showcode . "showcode"))) - (regexp ":\\(\"[^\"]*\"\\|(([^)]*) *([^)]*))\\|([^)]*)\\|[^ \t\n\r;,.]*\\)") - (case-fold-search t) p) - - ;; FIXME: set default options properly - (setq p (plist-put p :output-to-buffer t)) ;; FIXME: hack: null options plist is bad news - (setq p (plist-put p :replace t)) - (setq p (plist-put p :rownames nil)) - (setq p (plist-put p :colnames t)) - (setq p (plist-put p :inline nil)) - - (save-excursion - (while (looking-at "^#\\+\\(RR?:+\\) *\\(.*\\)") - (if (string= "R:" (match-string 1)) - (setq p (org-R-add-options-to-plist p (match-string 2) opts regexp))) - (forward-line))) - p)) - -(defun org-R-add-options-to-plist (p opt-string op regexp) - "Parse a #+R: line and set values in the property list p. -This function is adapted from similar functions in org-exp.el -and org-plot.el. It might be a good idea to have a single -function serving these three files' needs." - ;; Adapted from org-exp.el and org-plot.el - (let (o) - (when opt-string - (while (setq o (pop op)) - (if (string-match - (concat (regexp-quote (cdr o)) regexp) - opt-string) - (setq p (plist-put p (car o) - (car (read-from-string - (match-string 1 opt-string))))))))) - p) - - -(defun org-R-sanitise-options (options) - (error "not used yet") - (let (should-be-strings '(title legend colour color col csv))) - ) -(defun org-R-showcode (R) - "Display R function constructed by org-R in a new R-mode -buffer." - (split-window-vertically) - (switch-to-buffer "*org-table.R*") - (kill-region (point-min) (point-max)) - (R-mode) - (insert (replace-regexp-in-string - ";" "\n" (replace-regexp-in-string "\\([{}]\\)" "\n\\1\n" R))) - ;; (mark-whole-buffer) - ;; (indent-region) - ;; why doesn't that do what I hoped? - ) - -(defun org-R-get-remote-range (name-or-id form) - "Get a field value or a list of values in a range from table at ID. - -This is a refactoring of Carsten's original version. I have -extracted the first bit of his function and named it -org-R-find-table (which would presumably be called something like -org-table-find-table or org-id-find-table if this were accepted). - ---- - -Get a field value or a list of values in a range from table at ID. - -NAME-OR-ID may be the name of a table in the current file as set by -a \"#+TBLNAME:\" directive. The first table following this line -will then be used. Alternatively, it may be an ID referring to -any entry, possibly in a different file. In this case, the first table -in that entry will be referenced. -FORM is a field or range descriptor like \"@2$3\" or or \"B3\" or -\"@I$2..@II$2\". All the references must be absolute, not relative. - -The return value is either a single string for a single field, or a -list of the fields in the rectangle." - - (let ((tbl-marker (org-R-find-table name-or-id 'marker)) - org-table-column-names org-table-column-name-regexp - org-table-local-parameters org-table-named-field-locations - org-table-current-line-types org-table-current-begin-line - org-table-current-begin-pos org-table-dlines - org-table-hlines org-table-last-alignment - org-table-last-column-widths org-table-last-alignment - org-table-last-column-widths tbeg) - - (save-excursion - (set-buffer (marker-buffer tbl-marker)) - (goto-char (marker-position tbl-marker)) - (org-table-get-specials) - (setq form (org-table-formula-substitute-names form)) - (if (and (string-match org-table-range-regexp form) - (> (length (match-string 0 form)) 1)) - (save-match-data - (org-table-get-range (match-string 0 form) (point) 1)) - form)))) - -(provide 'org-R) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7fae6cc38..ccf4640db 100755 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -6,6 +6,12 @@ * org-exp.el (org-export-format-source-code-or-example): Fix textarea tag. +2010-02-24 Bastien Guerry + + * org-clock.el (org-clock-current-task): New variable to store + last clocked in task. + (org-clock-set-current, org-clock-delete-current): New functions. + 2010-02-24 Carsten Dominik * org-remember.el (org-remember-apply-template): Extend comment. diff --git a/lisp/org-clock.el b/lisp/org-clock.el index e3866be15..cb378e62c 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -944,6 +944,7 @@ the clocking selection, associated with the letter `d'." (org-back-to-heading t) (or interrupting (move-marker org-clock-interrupted-task nil)) (org-clock-history-push) + (org-clock-set-current) (cond ((functionp org-clock-in-switch-to-state) (looking-at org-complex-heading-regexp) (let ((newstate (funcall org-clock-in-switch-to-state @@ -1042,6 +1043,15 @@ the clocking selection, associated with the letter `d'." (message "Clock starts at %s - %s" ts msg-extra) (run-hooks 'org-clock-in-hook))))))) +(defvar org-clock-current-task nil + "Task currently clocked in.") +(defun org-clock-set-current () + "Set `org-clock-current-task' to the task currently clocked in." + (setq org-clock-current-task (org-get-heading))) +(defun org-clock-delete-current () + "Reset `org-clock-current-task' to nil." + (setq org-clock-current-task nil)) + (defun org-clock-mark-default-task () "Mark current task as default task." (interactive) @@ -1237,7 +1247,8 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (force-mode-line-update) (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m (if remove " => LINE REMOVED" "")) - (run-hooks 'org-clock-out-hook)))))) + (run-hooks 'org-clock-out-hook) + (org-clock-delete-current)))))) (defun org-clock-cancel () "Cancel the running clock be removing the start timestamp."