Function: org-babel-merge-params

org-babel-merge-params is a byte-compiled function defined in ob-core.el.gz.

Signature

(org-babel-merge-params &rest ALISTS)

Documentation

Combine all parameter association lists in ALISTS.

Later elements of ALISTS override the values of previous elements. This takes into account some special considerations for certain parameters when merging lists.

Source Code

;; Defined in /usr/src/emacs/lisp/org/ob-core.el.gz
(defun org-babel-merge-params (&rest alists)
  "Combine all parameter association lists in ALISTS.
Later elements of ALISTS override the values of previous elements.
This takes into account some special considerations for certain
parameters when merging lists."
  (let* ((results-exclusive-groups
	  (mapcar (lambda (group) (mapcar #'symbol-name group))
		  (cdr (assq 'results org-babel-common-header-args-w-values))))
	 (exports-exclusive-groups
	  (mapcar (lambda (group) (mapcar #'symbol-name group))
		  (cdr (assq 'exports org-babel-common-header-args-w-values))))
	 (merge
	  (lambda (exclusive-groups &rest result-params)
	    ;; Maintain exclusivity of mutually exclusive parameters,
	    ;; as defined in EXCLUSIVE-GROUPS while merging lists in
	    ;; RESULT-PARAMS.
	    (let (output)
	      (dolist (new-params result-params (delete-dups output))
		(dolist (new-param new-params)
		  (dolist (exclusive-group exclusive-groups)
		    (when (member new-param exclusive-group)
		      (setq output (cl-remove-if
				    (lambda (o) (member o exclusive-group))
				    output))))
		  (push new-param output))))))
	 (variable-index 0)		;Handle positional arguments.
	 clearnames
	 params				;Final parameters list.
	 ;; Some keywords accept multiple values.  We need to treat
	 ;; them specially.
	 vars results exports)
    (dolist (alist alists)
      (dolist (pair alist)
	(pcase pair
	  (`(:var . ,value)
	   (let ((name (cond
                        ;; Default header arguments can accept lambda
                        ;; functions.  We uniquely identify the var
                        ;; according to the full string contents of
                        ;; the lambda function.
			((functionp value) value)
			((listp value) (car value))
			((string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" value)
			 (intern (match-string 1 value)))
			(t nil))))
	     (cond
	      (name
	       (setq vars
		     (append (if (not (assoc name vars)) vars
			       (push name clearnames)
			       (cl-remove-if (lambda (p) (equal name (car p)))
					     vars))
			     (list (cons name pair)))))
	      ((and vars (nth variable-index vars))
	       ;; If no name is given and we already have named
	       ;; variables then assign to named variables in order.
	       (let ((name (car (nth variable-index vars))))
		 ;; Clear out colnames and rownames for replace vars.
		 (push name clearnames)
		 (setf (cddr (nth variable-index vars))
		       (concat (symbol-name name) "=" value))
		 (cl-incf variable-index)))
	      (t (error "Variable \"%s\" must be assigned a default value"
			(cdr pair))))))
	  (`(:results . ,value)
	   (setq results (funcall merge
				  results-exclusive-groups
				  results
				  (split-string
				   (cond ((stringp value) value)
                                         ((functionp value) (funcall value))
                                         ;; FIXME: Arbitrary code evaluation.
                                         (t (eval value t)))))))
	  (`(:exports . ,value)
	   (setq exports (funcall merge
				  exports-exclusive-groups
				  exports
                                  (split-string
                                   (cond ((and value (functionp value)) (funcall value))
                                         (value value)
                                         (t ""))))))
          ((or '(:dir . attach) '(:dir . "'attach"))
           (unless (org-attach-dir nil t)
             (error "No attachment directory for element (add :ID: or :DIR: property)"))
           (setq params (append
                         `((:dir . ,(org-attach-dir nil t))
                           (:mkdirp . "yes"))
                         (assq-delete-all :dir (assq-delete-all :mkdir params)))))
	  ;; Regular keywords: any value overwrites the previous one.
	  (_ (setq params (cons pair (assq-delete-all (car pair) params)))))))
    ;; Handle `:var' and clear out colnames and rownames for replaced
    ;; variables.
    (setq params (nconc (mapcar (lambda (v) (cons :var (cddr v))) vars)
			params))
    (dolist (name clearnames)
      (dolist (param '(:colname-names :rowname-names))
	(when (assq param params)
	  (setf (cdr (assq param params))
		(cl-remove-if (lambda (pair) (equal name (car pair)))
			      (cdr (assq param params))))
	  (setq params
		(cl-remove-if (lambda (pair) (and (equal (car pair) param)
						  (null (cdr pair))))
			      params)))))
    ;; Handle other special keywords, which accept multiple values.
    (setq params (nconc (list (cons :results (mapconcat #'identity results " "))
			      (cons :exports (mapconcat #'identity exports " ")))
			params))
    ;; Return merged params.
    (org-babel-eval-headers params)))