dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

ob-picolisp.el (7960B)


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