Browse Source

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.
Eric Schulte 8 years ago
parent
commit
5e4cffbb06
7 changed files with 109 additions and 23 deletions
  1. 25 4
      lisp/ob-R.el
  2. 1 1
      lisp/ob-clojure.el
  3. 1 1
      lisp/ob-lisp.el
  4. 3 2
      lisp/ob-sql.el
  5. 12 2
      lisp/ob-sqlite.el
  6. 49 13
      lisp/ob.el
  7. 18 0
      testing/lisp/test-ob.el

+ 25 - 4
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 '())

+ 1 - 1
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."

+ 1 - 1
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)"

+ 3 - 2
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."

+ 12 - 2
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)

+ 49 - 13
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 ()

+ 18 - 0
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