From ff3d974ff4d0aa93d3c241709557f6858ebf284f Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Tue, 10 Apr 2012 19:03:37 -0400 Subject: [PATCH] code-block languages may specify their own headers and values * lisp/ob-R.el (org-babel-header-args:R): Adding values. * lisp/ob-clojure.el (org-babel-header-args:clojure): Adding values. * lisp/ob-lisp.el (org-babel-header-args:lisp): Adding values. * lisp/ob-sql.el (org-babel-header-args:sql): Adding values. * lisp/ob-sqlite.el (org-babel-header-args:sqlite): Adding values. * lisp/ob.el (org-babel-combine-header-arg-lists): Combine lists of arguments and values. (org-babel-insert-header-arg): Use new combined header argument lists. (org-babel-header-arg-expand): Add support for completing-read insertion of header arguments after ":" (org-babel-enter-header-arg-w-completion): Completing read insertion of header arguments (org-tab-first-hook): Adding header argument completion. (org-babel-params-from-properties): Combining header argument lists. * testing/lisp/test-ob.el (ob-test/org-babel-combine-header-arg-lists): Test the new header argument combination functionality. --- lisp/ob-R.el | 29 +++++++++++++++++++--- lisp/ob-clojure.el | 2 +- lisp/ob-lisp.el | 2 +- lisp/ob-sql.el | 5 ++-- lisp/ob-sqlite.el | 14 +++++++++-- lisp/ob.el | 62 +++++++++++++++++++++++++++++++++++++---------- testing/lisp/test-ob.el | 18 ++++++++++++++ 7 files changed, 109 insertions(+), 23 deletions(-) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 49a8a85..9538dc4 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -40,10 +40,31 @@ (declare-function ess-eval-buffer "ext:ess-inf" (vis)) (declare-function org-number-sequence "org-compat" (from &optional to inc)) -(defconst org-babel-header-arg-names:R - '(width height bg units pointsize antialias quality compression - res type family title fonts version paper encoding - pagecentre colormodel useDingbats horizontal) +(defconst org-babel-header-args:R + '((width . :any) + (height . :any) + (bg . :any) + (units . :any) + (pointsize . :any) + (antialias . :any) + (quality . :any) + (compression . :any) + (res . :any) + (type . :any) + (family . :any) + (title . :any) + (fonts . :any) + (version . :any) + (paper . :any) + (encoding . :any) + (pagecentre . :any) + (colormodel . :any) + (useDingbats . :any) + (horizontal . :any) + (results . ((file list vector table scalar verbatim) + (raw org html latex code pp wrap) + (replace silent append prepend) + (output value graphics)))) "R-specific header arguments.") (defvar org-babel-default-header-args:R '()) diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el index 69d3db8..f389404 100644 --- a/lisp/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -45,7 +45,7 @@ (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) (defvar org-babel-default-header-args:clojure '()) -(defvar org-babel-header-arg-names:clojure '(package)) +(defvar org-babel-header-args:clojure '((package . :any))) (defun org-babel-expand-body:clojure (body params) "Expand BODY according to PARAMS, return the expanded body." diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el index 8fb6721..89dbe24 100644 --- a/lisp/ob-lisp.el +++ b/lisp/ob-lisp.el @@ -41,7 +41,7 @@ (add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp")) (defvar org-babel-default-header-args:lisp '()) -(defvar org-babel-header-arg-names:lisp '(package)) +(defvar org-babel-header-args:lisp '((package . :any))) (defcustom org-babel-lisp-dir-fmt "(let ((*default-pathname-defaults* #P%S)) %%s)" diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el index 20fbad3..e3f6edd 100644 --- a/lisp/ob-sql.el +++ b/lisp/ob-sql.el @@ -51,8 +51,9 @@ (defvar org-babel-default-header-args:sql '()) -(defvar org-babel-header-arg-names:sql - '(engine out-file)) +(defvar org-babel-header-args:sql + '((engine . :any) + (out-file . :any))) (defun org-babel-expand-body:sql (body params) "Expand BODY according to the values of PARAMS." diff --git a/lisp/ob-sqlite.el b/lisp/ob-sqlite.el index 84d6bb2..2106072 100644 --- a/lisp/ob-sqlite.el +++ b/lisp/ob-sqlite.el @@ -37,8 +37,18 @@ (defvar org-babel-default-header-args:sqlite '()) -(defvar org-babel-header-arg-names:sqlite - '(db header echo bail csv column html line list separator nullvalue) +(defvar org-babel-header-args:sqlite + '((db . :any) + (header . :any) + (echo . :any) + (bail . :any) + (csv . :any) + (column . :any) + (html . :any) + (line . :any) + (list . :any) + (separator . :any) + (nullvalue . :any)) "Sqlite specific header args.") (defun org-babel-expand-body:sqlite (body params) diff --git a/lisp/ob.el b/lisp/ob.el index 726245c..df401b0 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -622,6 +622,19 @@ arguments and pop open the results in a preview buffer." (mmin (in (1- i) j) (in i (1- j)) (in (1- i) (1- j))))))) (in l1 l2)))) +(defun org-babel-combine-header-arg-lists (original &rest others) + "Combine a number of lists of header argument names and arguments." + (let ((results (copy-sequence original))) + (dolist (new-list others) + (dolist (arg-pair new-list) + (let ((header (car arg-pair)) + (args (cdr arg-pair))) + (setq results + (cons arg-pair (org-remove-if + (lambda (pair) (equal header (car pair))) + results)))))) + results)) + ;;;###autoload (defun org-babel-check-src-block () "Check for misspelled header arguments in the current code block." @@ -649,12 +662,10 @@ arguments and pop open the results in a preview buffer." "Insert a header argument selecting from lists of common args and values." (interactive) (let* ((lang (car (org-babel-get-src-block-info 'light))) - (lang-headers (intern (concat "org-babel-header-arg-names:" lang))) - (headers (append (if (boundp lang-headers) - (mapcar (lambda (h) (cons h :any)) - (eval lang-headers)) - nil) - org-babel-common-header-args-w-values)) + (lang-headers (intern (concat "org-babel-header-args:" lang))) + (headers (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (if (boundp lang-headers) (eval lang-headers) nil))) (arg (org-icompleting-read "Header Arg: " (mapcar @@ -679,6 +690,30 @@ arguments and pop open the results in a preview buffer." ""))) vals "")))))))) +;; Add support for completing-read insertion of header arguments after ":" +(defun org-babel-header-arg-expand () + "Call `org-babel-enter-header-arg-w-completion' in appropriate contexts." + (when (and (= (char-before) ?\:) (org-babel-where-is-src-block-head)) + (org-babel-enter-header-arg-w-completion (match-string 2)))) + +(defun org-babel-enter-header-arg-w-completion (&optional lang) + "Insert header argument appropriate for LANG with completion." + (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang))) + (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var))) + (headers-w-values (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values lang-headers)) + (headers (mapcar #'symbol-name (mapcar #'car headers-w-values))) + (header (org-completing-read "Header Arg: " headers)) + (args (cdr (assoc (intern header) headers-w-values))) + (arg (when (and args (listp args)) + (org-completing-read + (format "%s: " header) + (mapcar #'symbol-name (apply #'append args)))))) + (insert (concat header " " (or arg ""))) + (cons header arg))) + +(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand) + ;;;###autoload (defun org-babel-load-in-session (&optional arg info) "Load the body of the current source-code block. @@ -1153,13 +1188,14 @@ may be specified in the properties of the current outline entry." (cons (intern (concat ":" header-arg)) (org-babel-read val)))) (mapcar - 'symbol-name - (append - org-babel-header-arg-names - (progn - (setq sym (intern (concat "org-babel-header-arg-names:" - lang))) - (and (boundp sym) (eval sym))))))))))) + #'symbol-name + (mapcar + #'car + (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (progn + (setq sym (intern (concat "org-babel-header-args:" lang))) + (and (boundp sym) (eval sym)))))))))))) (defvar org-src-preserve-indentation) (defun org-babel-parse-src-block-match () diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el index 4dac696..5cf689a 100644 --- a/testing/lisp/test-ob.el +++ b/testing/lisp/test-ob.el @@ -87,6 +87,24 @@ '((:session . "none") (:results . "replace") (:exports . "results")) org-babel-default-inline-header-args))) +(ert-deftest ob-test/org-babel-combine-header-arg-lists () + (let ((results (org-babel-combine-header-arg-lists + '((foo . :any) + (bar) + (baz . ((foo bar) (baz))) + (qux . ((foo bar baz qux))) + (quux . ((foo bar)))) + '((bar) + (baz . ((baz))) + (quux . :any))))) + (dolist (pair '((foo . :any) + (bar) + (baz . ((baz))) + (quux . :any) + (qux . ((foo bar baz qux))))) + (should (equal (cdr pair) + (cdr (assoc (car pair) results))))))) + ;;; ob-get-src-block-info (ert-deftest test-org-babel/get-src-block-info-language () (org-test-at-marker nil org-test-file-ob-anchor -- 1.7.10