ob-picolisp.el 7.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189
  1. ;;; ob-picolisp.el --- Babel Functions for Picolisp -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2010-2015 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 'comint)
  45. (eval-when-compile (require 'cl))
  46. (declare-function run-picolisp "ext:inferior-picolisp" (cmd))
  47. (defvar org-babel-tangle-lang-exts) ;; Autoloaded
  48. ;; optionally define a file extension for this language
  49. (add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l"))
  50. ;;; interferes with settings in org-babel buffer?
  51. ;; optionally declare default header arguments for this language
  52. ;; (defvar org-babel-default-header-args:picolisp
  53. ;; '((:colnames . "no"))
  54. ;; "Default arguments for evaluating a picolisp source block.")
  55. (defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe"
  56. "String to indicate that evaluation has completed.")
  57. (defcustom org-babel-picolisp-cmd "pil"
  58. "Name of command used to evaluate picolisp blocks."
  59. :group 'org-babel
  60. :version "24.1"
  61. :type 'string)
  62. (defun org-babel-expand-body:picolisp (body params)
  63. "Expand BODY according to PARAMS, return the expanded body."
  64. (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
  65. (print-level nil)
  66. (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-params (cdr (assoc :result-params params)))
  88. ;; Expand the body with `org-babel-expand-body:picolisp'.
  89. (full-body (org-babel-expand-body:picolisp body params))
  90. ;; Wrap body appropriately for the type of evaluation and results.
  91. (wrapped-body
  92. (cond
  93. ((or (member "code" result-params)
  94. (member "pp" result-params))
  95. (format "(pretty (out \"/dev/null\" %s))" full-body))
  96. ((and (member "value" result-params) (not session))
  97. (format "(print (out \"/dev/null\" %s))" full-body))
  98. ((member "value" result-params)
  99. (format "(out \"/dev/null\" %s)" full-body))
  100. (t full-body)))
  101. (result
  102. (if (not (string= session-name "none"))
  103. ;; Session based evaluation.
  104. (mapconcat ;; <- joins the list back into a single string
  105. #'identity
  106. (butlast ;; <- remove the org-babel-picolisp-eoe line
  107. (delq nil
  108. (mapcar
  109. (lambda (line)
  110. (org-babel-chomp ;; Remove trailing newlines.
  111. (when (> (length line) 0) ;; Remove empty lines.
  112. (cond
  113. ;; Remove leading "-> " from return values.
  114. ((and (>= (length line) 3)
  115. (string= "-> " (substring line 0 3)))
  116. (substring line 3))
  117. ;; Remove trailing "-> <<return-value>>" on the
  118. ;; last line of output.
  119. ((and (member "output" result-params)
  120. (string-match-p "->" line))
  121. (substring line 0 (string-match "->" line)))
  122. (t line)
  123. )
  124. ;;(if (and (>= (length line) 3);Remove leading "<-"
  125. ;; (string= "-> " (substring line 0 3)))
  126. ;; (substring line 3)
  127. ;; line)
  128. )))
  129. ;; Returns a list of the output of each evaluated exp.
  130. (org-babel-comint-with-output
  131. (session org-babel-picolisp-eoe)
  132. (insert wrapped-body) (comint-send-input)
  133. (insert "'" org-babel-picolisp-eoe)
  134. (comint-send-input)))))
  135. "\n")
  136. ;; external evaluation
  137. (let ((script-file (org-babel-temp-file "picolisp-script-")))
  138. (with-temp-file script-file
  139. (insert (concat wrapped-body "(bye)")))
  140. (org-babel-eval
  141. (format "%s %s"
  142. org-babel-picolisp-cmd
  143. (org-babel-process-file-name script-file))
  144. "")))))
  145. (org-babel-result-cond result-params
  146. result
  147. (read result))))
  148. (defun org-babel-picolisp-initiate-session (&optional session-name)
  149. "If there is not a current inferior-process-buffer in SESSION
  150. then create. Return the initialized session."
  151. (unless (string= session-name "none")
  152. (require 'inferior-picolisp)
  153. ;; provide a reasonable default session name
  154. (let ((session (or session-name "*inferior-picolisp*")))
  155. ;; check if we already have a live session by this name
  156. (if (org-babel-comint-buffer-livep session)
  157. (get-buffer session)
  158. (save-window-excursion
  159. (run-picolisp org-babel-picolisp-cmd)
  160. (rename-buffer session-name)
  161. (current-buffer))))))
  162. (provide 'ob-picolisp)
  163. ;;; ob-picolisp.el ends here