mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-11-21 06:55:35 +00:00
Don't use `org-flet' in some functions
* ob-ref.el (org-babel-ref-index-list): Use let* and rename the variable `length' to `lgth'. * org-plot.el (org-plot/gnuplot-to-grid-data): Don't use ̀org-flet'. * org-exp.el (org-export-format-source-code-or-example): Ditto. * org-exp-blocks.el (org-export-blocks-preprocess): Ditto. * ob.el (org-babel-view-src-block-info) (org-babel-execute-src-block, org-babel-edit-distance) (org-babel-switch-to-session-with-code) (org-babel-balanced-split, org-babel-insert-result): Ditto. * ob-ref.el (org-babel-ref-index-list): Ditto. * ob-python.el (org-babel-python-evaluate-session): Ditto. * ob-lob.el (org-babel-lob-get-info): Ditto. * ob-gnuplot.el (org-babel-expand-body:gnuplot): Ditto. * ob-exp.el (org-babel-exp-do-export): Ditto.
This commit is contained in:
Bastien Guerry
parent
a089a3bccc
commit
e85479aeb1
@ -227,13 +227,13 @@ org-mode text."
|
||||
(defun org-babel-exp-do-export (info type &optional hash)
|
||||
"Return a string with the exported content of a code block.
|
||||
The function respects the value of the :exports header argument."
|
||||
(org-flet ((silently () (let ((session (cdr (assoc :session (nth 2 info)))))
|
||||
(when (not (and session (equal "none" session)))
|
||||
(org-babel-exp-results info type 'silent))))
|
||||
(clean () (unless (eq type 'inline) (org-babel-remove-result info))))
|
||||
(let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info)))))
|
||||
(when (not (and session (equal "none" session)))
|
||||
(org-babel-exp-results info type 'silent)))))
|
||||
(clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info)))))
|
||||
(case (intern (or (cdr (assoc :exports (nth 2 info))) "code"))
|
||||
('none (silently) (clean) "")
|
||||
('code (silently) (clean) (org-babel-exp-code info))
|
||||
('none (funcall silently) (funcall clean) "")
|
||||
('code (funcall silently) (funcall clean) (org-babel-exp-code info))
|
||||
('results (org-babel-exp-results info type nil hash) "")
|
||||
('both (org-babel-exp-results info type nil hash)
|
||||
(org-babel-exp-code info)))))
|
||||
|
||||
@ -87,46 +87,45 @@ code."
|
||||
(timefmt (plist-get params :timefmt))
|
||||
(time-ind (or (plist-get params :timeind)
|
||||
(when timefmt 1)))
|
||||
(add-to-body (lambda (text) (setq body (concat text "\n" body))))
|
||||
output)
|
||||
(org-flet ((add-to-body (text)
|
||||
(setq body (concat text "\n" body))))
|
||||
;; append header argument settings to body
|
||||
(when title (add-to-body (format "set title '%s'" title))) ;; title
|
||||
(when lines (mapc (lambda (el) (add-to-body el)) lines)) ;; line
|
||||
(when sets
|
||||
(mapc (lambda (el) (add-to-body (format "set %s" el))) sets))
|
||||
(when x-labels
|
||||
(add-to-body
|
||||
(format "set xtics (%s)"
|
||||
(mapconcat (lambda (pair)
|
||||
(format "\"%s\" %d" (cdr pair) (car pair)))
|
||||
x-labels ", "))))
|
||||
(when y-labels
|
||||
(add-to-body
|
||||
(format "set ytics (%s)"
|
||||
(mapconcat (lambda (pair)
|
||||
(format "\"%s\" %d" (cdr pair) (car pair)))
|
||||
y-labels ", "))))
|
||||
(when time-ind
|
||||
(add-to-body "set xdata time")
|
||||
(add-to-body (concat "set timefmt \""
|
||||
(or timefmt
|
||||
"%Y-%m-%d-%H:%M:%S") "\"")))
|
||||
(when out-file (add-to-body (format "set output \"%s\"" out-file)))
|
||||
(when term (add-to-body (format "set term %s" term)))
|
||||
;; insert variables into code body: this should happen last
|
||||
;; placing the variables at the *top* of the code in case their
|
||||
;; values are used later
|
||||
(add-to-body (mapconcat #'identity
|
||||
(org-babel-variable-assignments:gnuplot params)
|
||||
"\n"))
|
||||
;; replace any variable names preceded by '$' with the actual
|
||||
;; value of the variable
|
||||
(mapc (lambda (pair)
|
||||
(setq body (replace-regexp-in-string
|
||||
(format "\\$%s" (car pair)) (cdr pair) body)))
|
||||
vars))
|
||||
body)))
|
||||
;; append header argument settings to body
|
||||
(when title (funcall add-to-body (format "set title '%s'" title))) ;; title
|
||||
(when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) ;; line
|
||||
(when sets
|
||||
(mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets))
|
||||
(when x-labels
|
||||
(funcall add-to-body
|
||||
(format "set xtics (%s)"
|
||||
(mapconcat (lambda (pair)
|
||||
(format "\"%s\" %d" (cdr pair) (car pair)))
|
||||
x-labels ", "))))
|
||||
(when y-labels
|
||||
(funcall add-to-body
|
||||
(format "set ytics (%s)"
|
||||
(mapconcat (lambda (pair)
|
||||
(format "\"%s\" %d" (cdr pair) (car pair)))
|
||||
y-labels ", "))))
|
||||
(when time-ind
|
||||
(funcall add-to-body "set xdata time")
|
||||
(funcall add-to-body (concat "set timefmt \""
|
||||
(or timefmt
|
||||
"%Y-%m-%d-%H:%M:%S") "\"")))
|
||||
(when out-file (funcall add-to-body (format "set output \"%s\"" out-file)))
|
||||
(when term (funcall add-to-body (format "set term %s" term)))
|
||||
;; insert variables into code body: this should happen last
|
||||
;; placing the variables at the *top* of the code in case their
|
||||
;; values are used later
|
||||
(funcall add-to-body (mapconcat #'identity
|
||||
(org-babel-variable-assignments:gnuplot params)
|
||||
"\n"))
|
||||
;; replace any variable names preceded by '$' with the actual
|
||||
;; value of the variable
|
||||
(mapc (lambda (pair)
|
||||
(setq body (replace-regexp-in-string
|
||||
(format "\\$%s" (car pair)) (cdr pair) body)))
|
||||
vars))
|
||||
body))
|
||||
|
||||
(defun org-babel-execute:gnuplot (body params)
|
||||
"Execute a block of Gnuplot code.
|
||||
|
||||
@ -97,49 +97,49 @@ if so then run the appropriate source block from the Library."
|
||||
;;;###autoload
|
||||
(defun org-babel-lob-get-info ()
|
||||
"Return a Library of Babel function call as a string."
|
||||
(org-flet ((nonempty (a b)
|
||||
(let ((it (match-string a)))
|
||||
(if (= (length it) 0) (match-string b) it))))
|
||||
(let ((case-fold-search t))
|
||||
(save-excursion
|
||||
(beginning-of-line 1)
|
||||
(when (looking-at org-babel-lob-one-liner-regexp)
|
||||
(append
|
||||
(mapcar #'org-babel-clean-text-properties
|
||||
(list
|
||||
(format "%s%s(%s)%s"
|
||||
(nonempty 3 12)
|
||||
(if (not (= 0 (length (nonempty 5 14))))
|
||||
(concat "[" (nonempty 5 14) "]") "")
|
||||
(or (nonempty 7 16) "")
|
||||
(or (nonempty 8 19) ""))
|
||||
(nonempty 9 18)))
|
||||
(list (length (if (= (length (match-string 12)) 0)
|
||||
(match-string 2) (match-string 11))))))))))
|
||||
(let ((case-fold-search t)
|
||||
(nonempty (lambda (a b)
|
||||
(let ((it (match-string a)))
|
||||
(if (= (length it) 0) (match-string b) it)))))
|
||||
(save-excursion
|
||||
(beginning-of-line 1)
|
||||
(when (looking-at org-babel-lob-one-liner-regexp)
|
||||
(append
|
||||
(mapcar #'org-babel-clean-text-properties
|
||||
(list
|
||||
(format "%s%s(%s)%s"
|
||||
(funcall nonempty 3 12)
|
||||
(if (not (= 0 (length (funcall nonempty 5 14))))
|
||||
(concat "[" (funcall nonempty 5 14) "]") "")
|
||||
(or (funcall nonempty 7 16) "")
|
||||
(or (funcall nonempty 8 19) ""))
|
||||
(funcall nonempty 9 18)))
|
||||
(list (length (if (= (length (match-string 12)) 0)
|
||||
(match-string 2) (match-string 11)))))))))
|
||||
|
||||
(defun org-babel-lob-execute (info)
|
||||
"Execute the lob call specified by INFO."
|
||||
(org-flet ((mkinfo (p) (list "emacs-lisp" "results" p nil nil (nth 2 info))))
|
||||
(let* ((pre-params (org-babel-merge-params
|
||||
org-babel-default-header-args
|
||||
(org-babel-params-from-properties)
|
||||
(org-babel-parse-header-arguments
|
||||
(org-babel-clean-text-properties
|
||||
(concat ":var results="
|
||||
(mapconcat #'identity (butlast info) " "))))))
|
||||
(pre-info (mkinfo pre-params))
|
||||
(cache? (and (cdr (assoc :cache pre-params))
|
||||
(string= "yes" (cdr (assoc :cache pre-params)))))
|
||||
(new-hash (when cache? (org-babel-sha1-hash pre-info)))
|
||||
(old-hash (when cache? (org-babel-current-result-hash))))
|
||||
(if (and cache? (equal new-hash old-hash))
|
||||
(save-excursion (goto-char (org-babel-where-is-src-block-result))
|
||||
(forward-line 1)
|
||||
(message "%S" (org-babel-read-result)))
|
||||
(prog1 (org-babel-execute-src-block
|
||||
nil (mkinfo (org-babel-process-params pre-params)))
|
||||
;; update the hash
|
||||
(when new-hash (org-babel-set-current-result-hash new-hash)))))))
|
||||
(let* ((mkinfo (lambda (p) (list "emacs-lisp" "results" p nil nil (nth 2 info))))
|
||||
(pre-params (org-babel-merge-params
|
||||
org-babel-default-header-args
|
||||
(org-babel-params-from-properties)
|
||||
(org-babel-parse-header-arguments
|
||||
(org-babel-clean-text-properties
|
||||
(concat ":var results="
|
||||
(mapconcat #'identity (butlast info) " "))))))
|
||||
(pre-info (funcall mkinfo pre-params))
|
||||
(cache? (and (cdr (assoc :cache pre-params))
|
||||
(string= "yes" (cdr (assoc :cache pre-params)))))
|
||||
(new-hash (when cache? (org-babel-sha1-hash pre-info)))
|
||||
(old-hash (when cache? (org-babel-current-result-hash))))
|
||||
(if (and cache? (equal new-hash old-hash))
|
||||
(save-excursion (goto-char (org-babel-where-is-src-block-result))
|
||||
(forward-line 1)
|
||||
(message "%S" (org-babel-read-result)))
|
||||
(prog1 (org-babel-execute-src-block
|
||||
nil (funcall mkinfo (org-babel-process-params pre-params)))
|
||||
;; update the hash
|
||||
(when new-hash (org-babel-set-current-result-hash new-hash))))))
|
||||
|
||||
(provide 'ob-lob)
|
||||
|
||||
|
||||
@ -238,22 +238,23 @@ last statement in BODY, as elisp."
|
||||
If RESULT-TYPE equals 'output then return standard output as a
|
||||
string. If RESULT-TYPE equals 'value then return the value of the
|
||||
last statement in BODY, as elisp."
|
||||
(org-flet ((send-wait () (comint-send-input nil t) (sleep-for 0 5))
|
||||
(let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5)))
|
||||
(dump-last-value
|
||||
(tmp-file pp)
|
||||
(mapc
|
||||
(lambda (statement) (insert statement) (send-wait))
|
||||
(if pp
|
||||
(list
|
||||
"import pprint"
|
||||
(format "open('%s', 'w').write(pprint.pformat(_))"
|
||||
(org-babel-process-file-name tmp-file 'noquote)))
|
||||
(list (format "open('%s', 'w').write(str(_))"
|
||||
(org-babel-process-file-name tmp-file 'noquote))))))
|
||||
(input-body (body)
|
||||
(mapc (lambda (line) (insert line) (send-wait))
|
||||
(split-string body "[\r\n]"))
|
||||
(send-wait)))
|
||||
(lambda
|
||||
(tmp-file pp)
|
||||
(mapc
|
||||
(lambda (statement) (insert statement) (funcall send-wait))
|
||||
(if pp
|
||||
(list
|
||||
"import pprint"
|
||||
(format "open('%s', 'w').write(pprint.pformat(_))"
|
||||
(org-babel-process-file-name tmp-file 'noquote)))
|
||||
(list (format "open('%s', 'w').write(str(_))"
|
||||
(org-babel-process-file-name tmp-file 'noquote)))))))
|
||||
(input-body (lambda (body)
|
||||
(mapc (lambda (line) (insert line) (funcall send-wait))
|
||||
(split-string body "[\r\n]"))
|
||||
(funcall send-wait))))
|
||||
((lambda (results)
|
||||
(unless (string= (substring org-babel-python-eoe-indicator 1 -1) results)
|
||||
(if (or (member "code" result-params)
|
||||
@ -269,21 +270,21 @@ last statement in BODY, as elisp."
|
||||
(butlast
|
||||
(org-babel-comint-with-output
|
||||
(session org-babel-python-eoe-indicator t body)
|
||||
(input-body body)
|
||||
(send-wait) (send-wait)
|
||||
(funcall input-body body)
|
||||
(funcall send-wait) (funcall send-wait)
|
||||
(insert org-babel-python-eoe-indicator)
|
||||
(send-wait))
|
||||
(funcall send-wait))
|
||||
2) "\n"))
|
||||
(value
|
||||
(let ((tmp-file (org-babel-temp-file "python-")))
|
||||
(org-babel-comint-with-output
|
||||
(session org-babel-python-eoe-indicator nil body)
|
||||
(let ((comint-process-echoes nil))
|
||||
(input-body body)
|
||||
(dump-last-value tmp-file (member "pp" result-params))
|
||||
(send-wait) (send-wait)
|
||||
(funcall input-body body)
|
||||
(funcall dump-last-value tmp-file (member "pp" result-params))
|
||||
(funcall send-wait) (funcall send-wait)
|
||||
(insert org-babel-python-eoe-indicator)
|
||||
(send-wait)))
|
||||
(funcall send-wait)))
|
||||
(org-babel-eval-read-file tmp-file)))))))
|
||||
|
||||
(defun org-babel-python-read-string (string)
|
||||
|
||||
@ -218,29 +218,30 @@ returned, or an empty string or \"*\" both of which are
|
||||
interpreted to mean the entire range and as such are equivalent
|
||||
to \"0:-1\"."
|
||||
(if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index))
|
||||
(let ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)")
|
||||
(length (length lis))
|
||||
(portion (match-string 1 index))
|
||||
(remainder (substring index (match-end 0))))
|
||||
(org-flet ((wrap (num) (if (< num 0) (+ length num) num))
|
||||
(open (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls)))
|
||||
(open
|
||||
(mapcar
|
||||
(lambda (sub-lis)
|
||||
(if (listp sub-lis)
|
||||
(org-babel-ref-index-list remainder sub-lis)
|
||||
sub-lis))
|
||||
(if (or (= 0 (length portion)) (string-match ind-re portion))
|
||||
(mapcar
|
||||
(lambda (n) (nth n lis))
|
||||
(apply 'org-number-sequence
|
||||
(if (and (> (length portion) 0) (match-string 2 portion))
|
||||
(list
|
||||
(wrap (string-to-number (match-string 2 portion)))
|
||||
(wrap (string-to-number (match-string 3 portion))))
|
||||
(list (wrap 0) (wrap -1)))))
|
||||
(list (nth (wrap (string-to-number portion)) lis)))))))
|
||||
lis))
|
||||
(let* ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)")
|
||||
(lgth (length lis))
|
||||
(portion (match-string 1 index))
|
||||
(remainder (substring index (match-end 0)))
|
||||
(wrap (lambda (num) (if (< num 0) (+ lgth num) num)))
|
||||
(open (lambda (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls))))
|
||||
(funcall
|
||||
open
|
||||
(mapcar
|
||||
(lambda (sub-lis)
|
||||
(if (listp sub-lis)
|
||||
(org-babel-ref-index-list remainder sub-lis)
|
||||
sub-lis))
|
||||
(if (or (= 0 (length portion)) (string-match ind-re portion))
|
||||
(mapcar
|
||||
(lambda (n) (nth n lis))
|
||||
(apply 'org-number-sequence
|
||||
(if (and (> (length portion) 0) (match-string 2 portion))
|
||||
(list
|
||||
(funcall wrap (string-to-number (match-string 2 portion)))
|
||||
(funcall wrap (string-to-number (match-string 3 portion))))
|
||||
(list (funcall wrap 0) (funcall wrap -1)))))
|
||||
(list (nth (funcall wrap (string-to-number portion)) lis)))))))
|
||||
lis)
|
||||
|
||||
(defun org-babel-ref-split-args (arg-string)
|
||||
"Split ARG-STRING into top-level arguments of balanced parenthesis."
|
||||
|
||||
141
lisp/ob.el
141
lisp/ob.el
@ -343,27 +343,27 @@ then run `org-babel-execute-src-block'."
|
||||
This includes header arguments, language and name, and is largely
|
||||
a window into the `org-babel-get-src-block-info' function."
|
||||
(interactive)
|
||||
(let ((info (org-babel-get-src-block-info 'light)))
|
||||
(org-flet ((full (it) (> (length it) 0))
|
||||
(printf (fmt &rest args) (princ (apply #'format fmt args))))
|
||||
(when info
|
||||
(with-help-window (help-buffer)
|
||||
(let ((name (nth 4 info))
|
||||
(lang (nth 0 info))
|
||||
(switches (nth 3 info))
|
||||
(header-args (nth 2 info)))
|
||||
(when name (printf "Name: %s\n" name))
|
||||
(when lang (printf "Lang: %s\n" lang))
|
||||
(when (full switches) (printf "Switches: %s\n" switches))
|
||||
(printf "Header Arguments:\n")
|
||||
(dolist (pair (sort header-args
|
||||
(lambda (a b) (string< (symbol-name (car a))
|
||||
(symbol-name (car b))))))
|
||||
(when (full (cdr pair))
|
||||
(printf "\t%S%s\t%s\n"
|
||||
(car pair)
|
||||
(if (> (length (format "%S" (car pair))) 7) "" "\t")
|
||||
(cdr pair))))))))))
|
||||
(let ((info (org-babel-get-src-block-info 'light))
|
||||
(full (lambda (it) (> (length it) 0)))
|
||||
(printf (lambda (fmt &rest args) (princ (apply #'format fmt args)))))
|
||||
(when info
|
||||
(with-help-window (help-buffer)
|
||||
(let ((name (nth 4 info))
|
||||
(lang (nth 0 info))
|
||||
(switches (nth 3 info))
|
||||
(header-args (nth 2 info)))
|
||||
(when name (funcall printf "Name: %s\n" name))
|
||||
(when lang (funcall printf "Lang: %s\n" lang))
|
||||
(when (funcall full switches) (funcall printf "Switches: %s\n" switches))
|
||||
(funcall printf "Header Arguments:\n")
|
||||
(dolist (pair (sort header-args
|
||||
(lambda (a b) (string< (symbol-name (car a))
|
||||
(symbol-name (car b))))))
|
||||
(when (funcall full (cdr pair))
|
||||
(funcall printf "\t%S%s\t%s\n"
|
||||
(car pair)
|
||||
(if (> (length (format "%S" (car pair))) 7) "" "\t")
|
||||
(cdr pair)))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-babel-expand-src-block-maybe ()
|
||||
@ -541,14 +541,14 @@ block."
|
||||
result cmd)
|
||||
(unwind-protect
|
||||
(org-flet ((call-process-region (&rest args)
|
||||
(apply 'org-babel-tramp-handle-call-process-region args)))
|
||||
(org-flet ((lang-check (f)
|
||||
(let ((f (intern (concat "org-babel-execute:" f))))
|
||||
(when (fboundp f) f))))
|
||||
(apply 'org-babel-tramp-handle-call-process-region args)))
|
||||
(let ((lang-check (lambda (f)
|
||||
(let ((f (intern (concat "org-babel-execute:" f))))
|
||||
(when (fboundp f) f)))))
|
||||
(setq cmd
|
||||
(or (lang-check lang)
|
||||
(lang-check (symbol-name
|
||||
(cdr (assoc lang org-src-lang-modes))))
|
||||
(or (funcall lang-check lang)
|
||||
(funcall lang-check (symbol-name
|
||||
(cdr (assoc lang org-src-lang-modes))))
|
||||
(error "No org-babel-execute function for %s!" lang))))
|
||||
(if (and (not arg) new-hash (equal new-hash old-hash))
|
||||
(save-excursion ;; return cached result
|
||||
@ -621,16 +621,18 @@ arguments and pop open the results in a preview buffer."
|
||||
(let* ((l1 (length s1))
|
||||
(l2 (length s2))
|
||||
(dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil))
|
||||
(number-sequence 1 (1+ l1))))))
|
||||
(org-flet ((in (i j) (aref (aref dist i) j))
|
||||
(mmin (&rest lst) (apply #'min (remove nil lst))))
|
||||
(number-sequence 1 (1+ l1)))))
|
||||
(in (lambda (i j) (aref (aref dist i) j)))
|
||||
(mmin (lambda (&rest lst) (apply #'min (remove nil lst)))))
|
||||
(setf (aref (aref dist 0) 0) 0)
|
||||
(dolist (i (number-sequence 1 l1))
|
||||
(dolist (j (number-sequence 1 l2))
|
||||
(setf (aref (aref dist i) j)
|
||||
(+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
|
||||
(mmin (in (1- i) j) (in i (1- j)) (in (1- i) (1- j)))))))
|
||||
(in l1 l2))))
|
||||
(funcall mmin (funcall in (1- i) j)
|
||||
(funcall in i (1- j))
|
||||
(funcall in (1- i) (1- j)))))))
|
||||
(funcall in l1 l2)))
|
||||
|
||||
(defun org-babel-combine-header-arg-lists (original &rest others)
|
||||
"Combine a number of lists of header argument names and arguments."
|
||||
@ -793,18 +795,18 @@ with a prefix argument then this is passed on to
|
||||
(defun org-babel-switch-to-session-with-code (&optional arg info)
|
||||
"Switch to code buffer and display session."
|
||||
(interactive "P")
|
||||
(org-flet ((swap-windows
|
||||
()
|
||||
(let ((other-window-buffer (window-buffer (next-window))))
|
||||
(set-window-buffer (next-window) (current-buffer))
|
||||
(set-window-buffer (selected-window) other-window-buffer))
|
||||
(other-window 1)))
|
||||
(let ((info (org-babel-get-src-block-info))
|
||||
(org-src-window-setup 'reorganize-frame))
|
||||
(let ((swap-windows
|
||||
(lambda ()
|
||||
(let ((other-window-buffer (window-buffer (next-window))))
|
||||
(set-window-buffer (next-window) (current-buffer))
|
||||
(set-window-buffer (selected-window) other-window-buffer))
|
||||
(other-window 1)))
|
||||
(info (org-babel-get-src-block-info))
|
||||
(org-src-window-setup 'reorganize-frame))
|
||||
(save-excursion
|
||||
(org-babel-switch-to-session arg info))
|
||||
(org-edit-src-code))
|
||||
(swap-windows)))
|
||||
(org-edit-src-code)
|
||||
(funcall swap-windows)))
|
||||
|
||||
(defmacro org-babel-do-in-edit-buffer (&rest body)
|
||||
"Evaluate BODY in edit buffer if there is a code block at point.
|
||||
@ -1268,31 +1270,32 @@ ALTS is a cons of two character options where each option may be
|
||||
either the numeric code of a single character or a list of
|
||||
character alternatives. For example to split on balanced
|
||||
instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
|
||||
(org-flet ((matches (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))
|
||||
(matched (ch last)
|
||||
(if (consp alts)
|
||||
(and (matches ch (cdr alts))
|
||||
(matches last (car alts)))
|
||||
(matches ch alts))))
|
||||
(let ((balance 0) (quote nil) (partial nil) (lst nil) (last 0))
|
||||
(mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]:
|
||||
(setq balance (+ balance
|
||||
(cond ((or (equal 91 ch) (equal 40 ch)) 1)
|
||||
((or (equal 93 ch) (equal 41 ch)) -1)
|
||||
(t 0))))
|
||||
(when (and (equal 34 ch) (not (equal 92 last)))
|
||||
(setq quote (not quote)))
|
||||
(setq partial (cons ch partial))
|
||||
(when (and (= balance 0) (not quote) (matched ch last))
|
||||
(setq lst (cons (apply #'string (nreverse
|
||||
(if (consp alts)
|
||||
(cddr partial)
|
||||
(cdr partial))))
|
||||
lst))
|
||||
(setq partial nil))
|
||||
(setq last ch))
|
||||
(string-to-list string))
|
||||
(nreverse (cons (apply #'string (nreverse partial)) lst)))))
|
||||
(let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch))))
|
||||
(matched (lambda (ch last)
|
||||
(if (consp alts)
|
||||
(and (funcall matches ch (cdr alts))
|
||||
(funcall matches last (car alts)))
|
||||
(funcall matches ch alts))))
|
||||
(balance 0) (last 0)
|
||||
quote partial lst)
|
||||
(mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]:
|
||||
(setq balance (+ balance
|
||||
(cond ((or (equal 91 ch) (equal 40 ch)) 1)
|
||||
((or (equal 93 ch) (equal 41 ch)) -1)
|
||||
(t 0))))
|
||||
(when (and (equal 34 ch) (not (equal 92 last)))
|
||||
(setq quote (not quote)))
|
||||
(setq partial (cons ch partial))
|
||||
(when (and (= balance 0) (not quote) (funcall matched ch last))
|
||||
(setq lst (cons (apply #'string (nreverse
|
||||
(if (consp alts)
|
||||
(cddr partial)
|
||||
(cdr partial))))
|
||||
lst))
|
||||
(setq partial nil))
|
||||
(setq last ch))
|
||||
(string-to-list string))
|
||||
(nreverse (cons (apply #'string (nreverse partial)) lst))))
|
||||
|
||||
(defun org-babel-join-splits-near-ch (ch list)
|
||||
"Join splits where \"=\" is on either end of the split."
|
||||
@ -1938,7 +1941,7 @@ code ---- the results are extracted in the syntax of the source
|
||||
(setq results-switches
|
||||
(if results-switches (concat " " results-switches) ""))
|
||||
(org-flet ((wrap (start finish)
|
||||
(goto-char end) (insert (concat finish "\n"))
|
||||
(goto-char end) (insert (concat finish "\n"))
|
||||
(goto-char beg) (insert (concat start "\n"))
|
||||
(goto-char end) (goto-char (point-at-eol))
|
||||
(setq end (point-marker)))
|
||||
|
||||
@ -172,71 +172,70 @@ which defaults to the value of `org-export-blocks-witheld'."
|
||||
(interactive)
|
||||
(save-window-excursion
|
||||
(let ((case-fold-search t)
|
||||
(types '())
|
||||
matched indentation type func
|
||||
(interblock (lambda (start end)
|
||||
(mapcar (lambda (pair) (funcall (second pair) start end))
|
||||
org-export-interblocks)))
|
||||
matched indentation type types func
|
||||
start end body headers preserve-indent progress-marker)
|
||||
(org-flet ((interblock (start end)
|
||||
(mapcar (lambda (pair) (funcall (second pair) start end))
|
||||
org-export-interblocks)))
|
||||
(goto-char (point-min))
|
||||
(setq start (point))
|
||||
(let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
|
||||
(while (re-search-forward beg-re nil t)
|
||||
(let* ((match-start (copy-marker (match-beginning 0)))
|
||||
(body-start (copy-marker (match-end 0)))
|
||||
(indentation (length (match-string 1)))
|
||||
(inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s"
|
||||
(regexp-quote (downcase (match-string 2)))))
|
||||
(type (intern (downcase (match-string 2))))
|
||||
(headers (save-match-data
|
||||
(org-split-string (match-string 3) "[ \t]+")))
|
||||
(balanced 1)
|
||||
(preserve-indent (or org-src-preserve-indentation
|
||||
(member "-i" headers)))
|
||||
match-end)
|
||||
(while (and (not (zerop balanced))
|
||||
(re-search-forward inner-re nil t))
|
||||
(if (string= (downcase (match-string 1)) "end")
|
||||
(decf balanced)
|
||||
(incf balanced)))
|
||||
(when (not (zerop balanced))
|
||||
(error "unbalanced begin/end_%s blocks with %S"
|
||||
type (buffer-substring match-start (point))))
|
||||
(setq match-end (copy-marker (match-end 0)))
|
||||
(unless preserve-indent
|
||||
(setq body (save-match-data (org-remove-indentation
|
||||
(buffer-substring
|
||||
body-start (match-beginning 0))))))
|
||||
(unless (memq type types) (setq types (cons type types)))
|
||||
(save-match-data (interblock start match-start))
|
||||
(when (setq func (cadr (assoc type org-export-blocks)))
|
||||
(let ((replacement (save-match-data
|
||||
(if (memq type org-export-blocks-witheld) ""
|
||||
(apply func body headers)))))
|
||||
;; ;; un-comment this code after the org-element merge
|
||||
;; (save-match-data
|
||||
;; (when (and replacement (string= replacement ""))
|
||||
;; (delete-region
|
||||
;; (car (org-element-collect-affiliated-keyword))
|
||||
;; match-start)))
|
||||
(when replacement
|
||||
(delete-region match-start match-end)
|
||||
(goto-char match-start) (insert replacement)
|
||||
(if preserve-indent
|
||||
;; indent only the code block markers
|
||||
(save-excursion
|
||||
(indent-line-to indentation) ; indent end_block
|
||||
(goto-char match-start)
|
||||
(indent-line-to indentation)) ; indent begin_block
|
||||
;; indent everything
|
||||
(indent-code-rigidly match-start (point) indentation)))))
|
||||
;; cleanup markers
|
||||
(set-marker match-start nil)
|
||||
(set-marker body-start nil)
|
||||
(set-marker match-end nil))
|
||||
(setq start (point))))
|
||||
(interblock start (point-max))
|
||||
(run-hooks 'org-export-blocks-postblock-hook)))))
|
||||
(goto-char (point-min))
|
||||
(setq start (point))
|
||||
(let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
|
||||
(while (re-search-forward beg-re nil t)
|
||||
(let* ((match-start (copy-marker (match-beginning 0)))
|
||||
(body-start (copy-marker (match-end 0)))
|
||||
(indentation (length (match-string 1)))
|
||||
(inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s"
|
||||
(regexp-quote (downcase (match-string 2)))))
|
||||
(type (intern (downcase (match-string 2))))
|
||||
(headers (save-match-data
|
||||
(org-split-string (match-string 3) "[ \t]+")))
|
||||
(balanced 1)
|
||||
(preserve-indent (or org-src-preserve-indentation
|
||||
(member "-i" headers)))
|
||||
match-end)
|
||||
(while (and (not (zerop balanced))
|
||||
(re-search-forward inner-re nil t))
|
||||
(if (string= (downcase (match-string 1)) "end")
|
||||
(decf balanced)
|
||||
(incf balanced)))
|
||||
(when (not (zerop balanced))
|
||||
(error "unbalanced begin/end_%s blocks with %S"
|
||||
type (buffer-substring match-start (point))))
|
||||
(setq match-end (copy-marker (match-end 0)))
|
||||
(unless preserve-indent
|
||||
(setq body (save-match-data (org-remove-indentation
|
||||
(buffer-substring
|
||||
body-start (match-beginning 0))))))
|
||||
(unless (memq type types) (setq types (cons type types)))
|
||||
(save-match-data (funcall interblock start match-start))
|
||||
(when (setq func (cadr (assoc type org-export-blocks)))
|
||||
(let ((replacement (save-match-data
|
||||
(if (memq type org-export-blocks-witheld) ""
|
||||
(apply func body headers)))))
|
||||
;; ;; un-comment this code after the org-element merge
|
||||
;; (save-match-data
|
||||
;; (when (and replacement (string= replacement ""))
|
||||
;; (delete-region
|
||||
;; (car (org-element-collect-affiliated-keyword))
|
||||
;; match-start)))
|
||||
(when replacement
|
||||
(delete-region match-start match-end)
|
||||
(goto-char match-start) (insert replacement)
|
||||
(if preserve-indent
|
||||
;; indent only the code block markers
|
||||
(save-excursion
|
||||
(indent-line-to indentation) ; indent end_block
|
||||
(goto-char match-start)
|
||||
(indent-line-to indentation)) ; indent begin_block
|
||||
;; indent everything
|
||||
(indent-code-rigidly match-start (point) indentation)))))
|
||||
;; cleanup markers
|
||||
(set-marker match-start nil)
|
||||
(set-marker body-start nil)
|
||||
(set-marker match-end nil))
|
||||
(setq start (point))))
|
||||
(funcall interblock start (point-max))
|
||||
(run-hooks 'org-export-blocks-postblock-hook))))
|
||||
|
||||
;;================================================================================
|
||||
;; type specific functions
|
||||
|
||||
103
lisp/org-exp.el
103
lisp/org-exp.el
@ -2734,65 +2734,64 @@ INDENT was the original indentation of the block."
|
||||
(setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
|
||||
(cond
|
||||
((and lang org-export-latex-listings)
|
||||
(org-flet ((make-option-string
|
||||
(pair)
|
||||
(concat (first pair)
|
||||
(if (> (length (second pair)) 0)
|
||||
(concat "=" (second pair))))))
|
||||
(let* ((lang-sym (intern lang))
|
||||
(minted-p (eq org-export-latex-listings 'minted))
|
||||
(listings-p (not minted-p))
|
||||
(backend-lang
|
||||
(or (cadr
|
||||
(assq
|
||||
lang-sym
|
||||
(cond
|
||||
(minted-p org-export-latex-minted-langs)
|
||||
(listings-p org-export-latex-listings-langs))))
|
||||
lang))
|
||||
(custom-environment
|
||||
(cadr
|
||||
(assq
|
||||
lang-sym
|
||||
org-export-latex-custom-lang-environments))))
|
||||
(concat
|
||||
(when (and listings-p (not custom-environment))
|
||||
(format
|
||||
"\\lstset{%s}\n"
|
||||
(mapconcat
|
||||
#'make-option-string
|
||||
(append org-export-latex-listings-options
|
||||
`(("language" ,backend-lang))) ",")))
|
||||
(when (and caption org-export-latex-listings-w-names)
|
||||
(format
|
||||
"\n%s $\\equiv$ \n"
|
||||
(replace-regexp-in-string "_" "\\\\_" caption)))
|
||||
(cond
|
||||
(custom-environment
|
||||
(format "\\begin{%s}\n%s\\end{%s}\n"
|
||||
custom-environment rtn custom-environment))
|
||||
(listings-p
|
||||
(format "\\begin{%s}\n%s\\end{%s}"
|
||||
"lstlisting" rtn "lstlisting"))
|
||||
(minted-p
|
||||
(format
|
||||
"\\begin{minted}[%s]{%s}\n%s\\end{minted}"
|
||||
(mapconcat #'make-option-string
|
||||
org-export-latex-minted-options ",")
|
||||
backend-lang rtn)))))))
|
||||
(let* ((make-option-string
|
||||
(lambda (pair)
|
||||
(concat (first pair)
|
||||
(if (> (length (second pair)) 0)
|
||||
(concat "=" (second pair))))))
|
||||
(lang-sym (intern lang))
|
||||
(minted-p (eq org-export-latex-listings 'minted))
|
||||
(listings-p (not minted-p))
|
||||
(backend-lang
|
||||
(or (cadr
|
||||
(assq
|
||||
lang-sym
|
||||
(cond
|
||||
(minted-p org-export-latex-minted-langs)
|
||||
(listings-p org-export-latex-listings-langs))))
|
||||
lang))
|
||||
(custom-environment
|
||||
(cadr
|
||||
(assq
|
||||
lang-sym
|
||||
org-export-latex-custom-lang-environments))))
|
||||
(concat
|
||||
(when (and listings-p (not custom-environment))
|
||||
(format
|
||||
"\\lstset{%s}\n"
|
||||
(mapconcat
|
||||
make-option-string
|
||||
(append org-export-latex-listings-options
|
||||
`(("language" ,backend-lang))) ",")))
|
||||
(when (and caption org-export-latex-listings-w-names)
|
||||
(format
|
||||
"\n%s $\\equiv$ \n"
|
||||
(replace-regexp-in-string "_" "\\\\_" caption)))
|
||||
(cond
|
||||
(custom-environment
|
||||
(format "\\begin{%s}\n%s\\end{%s}\n"
|
||||
custom-environment rtn custom-environment))
|
||||
(listings-p
|
||||
(format "\\begin{%s}\n%s\\end{%s}"
|
||||
"lstlisting" rtn "lstlisting"))
|
||||
(minted-p
|
||||
(format
|
||||
"\\begin{minted}[%s]{%s}\n%s\\end{minted}"
|
||||
(mapconcat make-option-string
|
||||
org-export-latex-minted-options ",")
|
||||
backend-lang rtn))))))
|
||||
(t (concat (car org-export-latex-verbatim-wrap)
|
||||
rtn (cdr org-export-latex-verbatim-wrap)))))
|
||||
((eq org-export-current-backend 'ascii)
|
||||
;; This is not HTML or LaTeX, so just make it an example.
|
||||
(setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
|
||||
(concat caption "\n"
|
||||
((eq org-export-current-backend 'ascii)
|
||||
;; This is not HTML or LaTeX, so just make it an example.
|
||||
(setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
|
||||
(concat caption "\n"
|
||||
(concat
|
||||
(mapconcat
|
||||
(lambda (l) (concat " " l))
|
||||
(org-split-string rtn "\n")
|
||||
"\n")
|
||||
"\n")
|
||||
))
|
||||
"\n")))
|
||||
(t
|
||||
(error "Don't know how to markup source or example block in %s"
|
||||
(upcase backend-name)))))
|
||||
|
||||
@ -144,7 +144,8 @@ and dependant variables."
|
||||
(dotimes (col (length (first table)))
|
||||
(setf collector (cons col collector)))
|
||||
collector)))
|
||||
row-vals (counter 0))
|
||||
(counter 0)
|
||||
row-vals)
|
||||
(when (>= ind 0) ;; collect values of ind col
|
||||
(setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter))
|
||||
(cons counter (nth ind row))) table)))
|
||||
@ -159,26 +160,26 @@ and dependant variables."
|
||||
;; write table to gnuplot grid datafile format
|
||||
(with-temp-file data-file
|
||||
(let ((num-rows (length table)) (num-cols (length (first table)))
|
||||
(gnuplot-row (lambda (col row value)
|
||||
(setf col (+ 1 col)) (setf row (+ 1 row))
|
||||
(format "%f %f %f\n%f %f %f\n"
|
||||
col (- row 0.5) value ;; lower edge
|
||||
col (+ row 0.5) value))) ;; upper edge
|
||||
front-edge back-edge)
|
||||
(org-flet ((gnuplot-row (col row value)
|
||||
(setf col (+ 1 col)) (setf row (+ 1 row))
|
||||
(format "%f %f %f\n%f %f %f\n"
|
||||
col (- row 0.5) value ;; lower edge
|
||||
col (+ row 0.5) value))) ;; upper edge
|
||||
(dotimes (col num-cols)
|
||||
(dotimes (row num-rows)
|
||||
(setf back-edge
|
||||
(concat back-edge
|
||||
(gnuplot-row (- col 1) row (string-to-number
|
||||
(nth col (nth row table))))))
|
||||
(setf front-edge
|
||||
(concat front-edge
|
||||
(gnuplot-row col row (string-to-number
|
||||
(nth col (nth row table)))))))
|
||||
;; only insert once per row
|
||||
(insert back-edge) (insert "\n") ;; back edge
|
||||
(insert front-edge) (insert "\n") ;; front edge
|
||||
(setf back-edge "") (setf front-edge "")))))
|
||||
(dotimes (col num-cols)
|
||||
(dotimes (row num-rows)
|
||||
(setf back-edge
|
||||
(concat back-edge
|
||||
(funcall gnuplot-row (- col 1) row
|
||||
(string-to-number (nth col (nth row table))))))
|
||||
(setf front-edge
|
||||
(concat front-edge
|
||||
(funcall gnuplot-row col row
|
||||
(string-to-number (nth col (nth row table)))))))
|
||||
;; only insert once per row
|
||||
(insert back-edge) (insert "\n") ;; back edge
|
||||
(insert front-edge) (insert "\n") ;; front edge
|
||||
(setf back-edge "") (setf front-edge ""))))
|
||||
row-vals))
|
||||
|
||||
(defun org-plot/gnuplot-script (data-file num-cols params &optional preface)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user