ob-picolisp.el 7.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188
  1. ;;; ob-picolisp.el --- Babel Functions for Picolisp -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2010-2019 Free Software Foundation, Inc.
  3. ;; Authors: Thorsten Jolitz
  4. ;; Eric Schulte
  5. ;; Keywords: literate programming, reproducible research
  6. ;; Homepage: https://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 <https://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. ;; an 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, an Emacs library written
  34. ;; in Emacs Lisp, PicoLisp has at least two outstanding features that
  35. ;; 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. (declare-function run-picolisp "ext:inferior-picolisp" (cmd))
  46. (defvar org-babel-tangle-lang-exts) ;; Autoloaded
  47. ;; optionally define a file extension for this language
  48. (add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l"))
  49. ;;; interferes with settings in org-babel buffer?
  50. ;; optionally declare default header arguments for this language
  51. ;; (defvar org-babel-default-header-args:picolisp
  52. ;; '((:colnames . "no"))
  53. ;; "Default arguments for evaluating a picolisp source block.")
  54. (defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe"
  55. "String to indicate that evaluation has completed.")
  56. (defcustom org-babel-picolisp-cmd "pil"
  57. "Name of command used to evaluate picolisp blocks."
  58. :group 'org-babel
  59. :version "24.1"
  60. :type 'string)
  61. (defun org-babel-expand-body:picolisp (body params)
  62. "Expand BODY according to PARAMS, return the expanded body."
  63. (let ((vars (org-babel--get-vars params))
  64. (print-level nil)
  65. (print-length nil))
  66. (if (> (length vars) 0)
  67. (concat "(prog (let ("
  68. (mapconcat
  69. (lambda (var)
  70. (format "%S '%S)"
  71. (print (car var))
  72. (print (cdr var))))
  73. vars "\n ")
  74. " \n" body ") )")
  75. body)))
  76. (defun org-babel-execute:picolisp (body params)
  77. "Execute a block of Picolisp code with org-babel.
  78. This function is called by `org-babel-execute-src-block'."
  79. (message "executing Picolisp source code block")
  80. (let* (
  81. ;; Name of the session or "none".
  82. (session-name (cdr (assq :session params)))
  83. ;; Set the session if the session variable is non-nil.
  84. (session (org-babel-picolisp-initiate-session session-name))
  85. ;; Either OUTPUT or VALUE which should behave as described above.
  86. (result-params (cdr (assq :result-params params)))
  87. ;; Expand the body with `org-babel-expand-body:picolisp'.
  88. (full-body (org-babel-expand-body:picolisp body params))
  89. ;; Wrap body appropriately for the type of evaluation and results.
  90. (wrapped-body
  91. (cond
  92. ((or (member "code" result-params)
  93. (member "pp" result-params))
  94. (format "(pretty (out \"/dev/null\" %s))" full-body))
  95. ((and (member "value" result-params) (not session))
  96. (format "(print (out \"/dev/null\" %s))" full-body))
  97. ((member "value" result-params)
  98. (format "(out \"/dev/null\" %s)" full-body))
  99. (t full-body)))
  100. (result
  101. (if (not (string= session-name "none"))
  102. ;; Session based evaluation.
  103. (mapconcat ;; <- joins the list back into a single string
  104. #'identity
  105. (butlast ;; <- remove the org-babel-picolisp-eoe line
  106. (delq nil
  107. (mapcar
  108. (lambda (line)
  109. (org-babel-chomp ;; Remove trailing newlines.
  110. (when (> (length line) 0) ;; Remove empty lines.
  111. (cond
  112. ;; Remove leading "-> " from return values.
  113. ((and (>= (length line) 3)
  114. (string= "-> " (substring line 0 3)))
  115. (substring line 3))
  116. ;; Remove trailing "-> <<return-value>>" on the
  117. ;; last line of output.
  118. ((and (member "output" result-params)
  119. (string-match-p "->" line))
  120. (substring line 0 (string-match "->" line)))
  121. (t line)
  122. )
  123. ;;(if (and (>= (length line) 3);Remove leading "<-"
  124. ;; (string= "-> " (substring line 0 3)))
  125. ;; (substring line 3)
  126. ;; line)
  127. )))
  128. ;; Returns a list of the output of each evaluated exp.
  129. (org-babel-comint-with-output
  130. (session org-babel-picolisp-eoe)
  131. (insert wrapped-body) (comint-send-input)
  132. (insert "'" org-babel-picolisp-eoe)
  133. (comint-send-input)))))
  134. "\n")
  135. ;; external evaluation
  136. (let ((script-file (org-babel-temp-file "picolisp-script-")))
  137. (with-temp-file script-file
  138. (insert (concat wrapped-body "(bye)")))
  139. (org-babel-eval
  140. (format "%s %s"
  141. org-babel-picolisp-cmd
  142. (org-babel-process-file-name script-file))
  143. "")))))
  144. (org-babel-result-cond result-params
  145. result
  146. (read result))))
  147. (defun org-babel-picolisp-initiate-session (&optional session-name)
  148. "If there is not a current inferior-process-buffer in SESSION
  149. then create. Return the initialized session."
  150. (unless (string= session-name "none")
  151. (require 'inferior-picolisp)
  152. ;; provide a reasonable default session name
  153. (let ((session (or session-name "*inferior-picolisp*")))
  154. ;; check if we already have a live session by this name
  155. (if (org-babel-comint-buffer-livep session)
  156. (get-buffer session)
  157. (save-window-excursion
  158. (run-picolisp org-babel-picolisp-cmd)
  159. (rename-buffer session-name)
  160. (current-buffer))))))
  161. (provide 'ob-picolisp)
  162. ;;; ob-picolisp.el ends here