ob-picolisp.el 7.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194
  1. ;;; ob-picolisp.el --- org-babel functions for picolisp evaluation
  2. ;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
  3. ;; Authors: Thorsten Jolitz
  4. ;; Eric Schulte
  5. ;; Keywords: literate programming, reproducible research
  6. ;; Homepage: http://orgmode.org
  7. ;; This file is part of GNU Emacs.
  8. ;; GNU Emacs is free software: you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;; This library enables the use of PicoLisp in the multi-language
  20. ;; programming framework Org-Babel. PicoLisp is a minimal yet
  21. ;; fascinating lisp dialect and a highly productive application
  22. ;; framework for web-based client-server applications on top of
  23. ;; object-oriented databases. A good way to learn PicoLisp is to first
  24. ;; read Paul Grahams essay "The hundred year language"
  25. ;; (http://www.paulgraham.com/hundred.html) and then study the various
  26. ;; documents and essays published in the PicoLisp wiki
  27. ;; (http://picolisp.com/5000/-2.html). PicoLisp is included in some
  28. ;; GNU/Linux Distributions, and can be downloaded here:
  29. ;; http://software-lab.de/down.html. It ships with a picolisp-mode and
  30. ;; a inferior-picolisp-mode for Emacs (to be found in the /lib/el/
  31. ;; directory).
  32. ;; Although it might seem more natural to use Emacs Lisp for most
  33. ;; Lisp-based programming tasks inside Org-Mode, an Emacs library
  34. ;; written in Emacs Lisp, PicoLisp has at least two outstanding
  35. ;; features that make it a valuable addition to Org-Babel:
  36. ;; PicoLisp _is_ an object-oriented database with a Prolog-based query
  37. ;; language implemented in PicoLisp (Pilog). Database objects are
  38. ;; first-class members of the language.
  39. ;; PicoLisp is an extremely productive framework for the development
  40. ;; of interactive web-applications (on top of a database).
  41. ;;; Requirements:
  42. ;;; Code:
  43. (require 'ob)
  44. (require 'ob-eval)
  45. (require 'ob-comint)
  46. (require 'comint)
  47. (eval-when-compile (require 'cl))
  48. (declare-function run-picolisp "ext:inferior-picolisp" (cmd))
  49. ;; optionally define a file extension for this language
  50. (add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l"))
  51. ;;; interferes with settings in org-babel buffer?
  52. ;; optionally declare default header arguments for this language
  53. ;; (defvar org-babel-default-header-args:picolisp
  54. ;; '((:colnames . "no"))
  55. ;; "Default arguments for evaluating a picolisp source block.")
  56. (defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe"
  57. "String to indicate that evaluation has completed.")
  58. (defcustom org-babel-picolisp-cmd "pil"
  59. "Name of command used to evaluate picolisp blocks."
  60. :group 'org-babel
  61. :type 'string)
  62. (defun org-babel-expand-body:picolisp (body params &optional processed-params)
  63. "Expand BODY according to PARAMS, return the expanded body."
  64. (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
  65. (result-params (cdr (assoc :result-params params)))
  66. (print-level nil) (print-length nil))
  67. (if (> (length vars) 0)
  68. (concat "(prog (let ("
  69. (mapconcat
  70. (lambda (var)
  71. (format "%S '%S)"
  72. (print (car var))
  73. (print (cdr var))))
  74. vars "\n ")
  75. " \n" body ") )")
  76. body)))
  77. (defun org-babel-execute:picolisp (body params)
  78. "Execute a block of Picolisp code with org-babel. This function is
  79. called by `org-babel-execute-src-block'"
  80. (message "executing Picolisp source code block")
  81. (let* (
  82. ;; name of the session or "none"
  83. (session-name (cdr (assoc :session params)))
  84. ;; set the session if the session variable is non-nil
  85. (session (org-babel-picolisp-initiate-session session-name))
  86. ;; either OUTPUT or VALUE which should behave as described above
  87. (result-type (cdr (assoc :result-type params)))
  88. (result-params (cdr (assoc :result-params params)))
  89. ;; expand the body with `org-babel-expand-body:picolisp'
  90. (full-body (org-babel-expand-body:picolisp body params))
  91. ;; wrap body appropriately for the type of evaluation and results
  92. (wrapped-body
  93. (cond
  94. ((or (member "code" result-params)
  95. (member "pp" result-params))
  96. (format "(pretty (out \"/dev/null\" %s))" full-body))
  97. ((and (member "value" result-params) (not session))
  98. (format "(print (out \"/dev/null\" %s))" full-body))
  99. ((member "value" result-params)
  100. (format "(out \"/dev/null\" %s)" full-body))
  101. (t full-body))))
  102. ((lambda (result)
  103. (if (or (member "verbatim" result-params)
  104. (member "scalar" result-params)
  105. (member "output" result-params)
  106. (member "code" result-params)
  107. (member "pp" result-params)
  108. (= (length result) 0))
  109. result
  110. (read result)))
  111. (if (not (string= session-name "none"))
  112. ;; session based evaluation
  113. (mapconcat ;; <- joins the list back together into a single string
  114. #'identity
  115. (butlast ;; <- remove the org-babel-picolisp-eoe line
  116. (delq nil
  117. (mapcar
  118. (lambda (line)
  119. (org-babel-chomp ;; remove trailing newlines
  120. (when (> (length line) 0) ;; remove empty lines
  121. (cond
  122. ;; remove leading "-> " from return values
  123. ((and (>= (length line) 3)
  124. (string= "-> " (substring line 0 3)))
  125. (substring line 3))
  126. ;; remove trailing "-> <<return-value>>" on the
  127. ;; last line of output
  128. ((and (member "output" result-params)
  129. (string-match-p "->" line))
  130. (substring line 0 (string-match "->" line)))
  131. (t line)
  132. )
  133. ;; (if (and (>= (length line) 3) ;; remove leading "<- "
  134. ;; (string= "-> " (substring line 0 3)))
  135. ;; (substring line 3)
  136. ;; line)
  137. )))
  138. ;; returns a list of the output of each evaluated expression
  139. (org-babel-comint-with-output (session org-babel-picolisp-eoe)
  140. (insert wrapped-body) (comint-send-input)
  141. (insert "'" org-babel-picolisp-eoe) (comint-send-input)))))
  142. "\n")
  143. ;; external evaluation
  144. (let ((script-file (org-babel-temp-file "picolisp-script-")))
  145. (with-temp-file script-file
  146. (insert (concat wrapped-body "(bye)")))
  147. (org-babel-eval
  148. (format "%s %s"
  149. org-babel-picolisp-cmd
  150. (org-babel-process-file-name script-file))
  151. ""))))))
  152. (defun org-babel-picolisp-initiate-session (&optional session-name)
  153. "If there is not a current inferior-process-buffer in SESSION
  154. then create. Return the initialized session."
  155. (unless (string= session-name "none")
  156. (require 'inferior-picolisp)
  157. ;; provide a reasonable default session name
  158. (let ((session (or session-name "*inferior-picolisp*")))
  159. ;; check if we already have a live session by this name
  160. (if (org-babel-comint-buffer-livep session)
  161. (get-buffer session)
  162. (save-window-excursion
  163. (run-picolisp org-babel-picolisp-cmd)
  164. (rename-buffer session-name)
  165. (current-buffer))))))
  166. (provide 'ob-picolisp)
  167. ;;; ob-picolisp.el ends here