diff options
author | Bastien Guerry <bzg@altern.org> | 2012-08-09 16:13:18 +0200 |
---|---|---|
committer | Bastien Guerry <bzg@altern.org> | 2012-08-09 21:06:33 +0200 |
commit | e85479aeb1ede3791cd21412c4aa14184d92c26f (patch) | |
tree | e086cd9062d34c79211de87a8fb053e1ab90a5c0 | |
parent | a089a3bccc35c553f834d93e20814e50014e3afd (diff) | |
download | org-mode-e85479aeb1ede3791cd21412c4aa14184d92c26f.tar.gz |
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.
-rw-r--r-- | lisp/ob-exp.el | 12 | ||||
-rw-r--r-- | lisp/ob-gnuplot.el | 77 | ||||
-rw-r--r-- | lisp/ob-lob.el | 80 | ||||
-rw-r--r-- | lisp/ob-python.el | 45 | ||||
-rw-r--r-- | lisp/ob-ref.el | 47 | ||||
-rw-r--r-- | lisp/ob.el | 141 | ||||
-rw-r--r-- | lisp/org-exp-blocks.el | 127 | ||||
-rw-r--r-- | lisp/org-exp.el | 103 | ||||
-rw-r--r-- | lisp/org-plot.el | 41 |
9 files changed, 338 insertions, 335 deletions
diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 894248a..604689e 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -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))))) diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el index 9b9f9c9..55c4153 100644 --- a/lisp/ob-gnuplot.el +++ b/lisp/ob-gnuplot.el @@ -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. diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el index ab56d9e..53d0933 100644 --- a/lisp/ob-lob.el +++ b/lisp/ob-lob.el @@ -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) diff --git a/lisp/ob-python.el b/lisp/ob-python.el index fea1b63..dc536fe 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -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) diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index 6180e0b..19a66bc 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -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." @@ -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))) diff --git a/lisp/org-exp-blocks.el b/lisp/org-exp-blocks.el index b46f743..8d85f6d 100644 --- a/lisp/org-exp-blocks.el +++ b/lisp/org-exp-blocks.el @@ -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 diff --git a/lisp/org-exp.el b/lisp/org-exp.el index f93a4bf..9029920 100644 --- a/lisp/org-exp.el +++ b/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))))) diff --git a/lisp/org-plot.el b/lisp/org-plot.el index 0f3e18b..64a5b9e 100644 --- a/lisp/org-plot.el +++ b/lisp/org-plot.el @@ -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) |