Skip to content
Snippets Groups Projects
Commit e29ef52e authored by erwan's avatar erwan
Browse files

Update: try to get colorisation in the html generated from the org in the guide (still not working)

parent e5eb17d9
No related branches found
No related tags found
No related merge requests found
......@@ -7,6 +7,7 @@ all:README.html
EMACS=emacs \
--load=htmlize.el \
--load=ob-ocaml.el \
--load=emacs-org.el
%.html2:
......@@ -14,7 +15,3 @@ EMACS=emacs \
clean:
rm *.html
......@@ -72,6 +72,7 @@ registred using the string used in dot file algo fields with:
which profiles is defined in [[https://gricad-gitlab.univ-grenoble-alpes.fr/verimag/synchrone/sasa/blob/master/lib/algo/algo.mli][algo.mli]]
#+BEGIN_SRC ocaml
let x = ref 6 in
!x
......
;;; ob-ocaml.el --- org-babel functions for ocaml evaluation
;;; ob-ocaml.el --- Babel Functions for Ocaml -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
......@@ -19,7 +19,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
......@@ -36,12 +36,12 @@
;;; Code:
(require 'ob)
(require 'ob-comint)
(require 'comint)
(eval-when-compile (require 'cl))
(declare-function tuareg-run-caml "ext:tuareg" ())
(declare-function tuareg-run-ocaml "ext:tuareg" ())
(declare-function tuareg-interactive-send-input "ext:tuareg" ())
(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml"))
......@@ -51,19 +51,26 @@
(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;")
(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe")
(defcustom org-babel-ocaml-command "ocaml"
"Name of the command for executing Ocaml code."
:version "24.4"
:package-version '(Org . "8.0")
:group 'org-babel
:type 'string)
(defun org-babel-execute:ocaml (body params)
"Execute a block of Ocaml code with Babel."
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(full-body (org-babel-expand-body:generic
(let* ((full-body (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:ocaml params)))
(session (org-babel-prep-session:ocaml
(cdr (assoc :session params)) params))
(cdr (assq :session params)) params))
(raw (org-babel-comint-with-output
(session org-babel-ocaml-eoe-output t full-body)
(session org-babel-ocaml-eoe-output nil full-body)
(insert
(concat
(org-babel-chomp full-body)"\n"org-babel-ocaml-eoe-indicator))
(org-babel-chomp full-body) ";;\n"
org-babel-ocaml-eoe-indicator))
(tuareg-interactive-send-input)))
(clean
(car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out)
......@@ -72,16 +79,31 @@
(progn (setq out nil) line)
(when (string-match re line)
(progn (setq out t) nil))))
(mapcar #'org-babel-trim (reverse raw))))))))
(org-babel-reassemble-table
(org-babel-ocaml-parse-output (org-babel-trim clean))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
(mapcar #'org-trim (reverse raw)))))))
(raw (org-trim clean))
(result-params (cdr (assq :result-params params))))
(string-match
"\\(\\(.*\n\\)*\\)[^:\n]+ : \\([^=\n]+\\) =\\(\n\\| \\)\\(.+\\)$"
raw)
(let ((output (match-string 1 raw))
(type (match-string 3 raw))
(value (match-string 5 raw)))
(org-babel-reassemble-table
(org-babel-result-cond result-params
(cond
((member "verbatim" result-params) raw)
((member "output" result-params) output)
(t raw))
(if (and value type)
(org-babel-ocaml-parse-output value type)
raw))
(org-babel-pick-name
(cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
(cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
(defvar tuareg-interactive-buffer-name)
(defun org-babel-prep-session:ocaml (session params)
(defun org-babel-prep-session:ocaml (session _params)
"Prepare SESSION according to the header arguments in PARAMS."
(require 'tuareg)
(let ((tuareg-interactive-buffer-name (if (and (not (string= session "none"))
......@@ -89,15 +111,17 @@
(stringp session))
session
tuareg-interactive-buffer-name)))
(save-window-excursion (tuareg-run-caml)
(get-buffer tuareg-interactive-buffer-name))))
(save-window-excursion (if (fboundp 'tuareg-run-process-if-needed)
(tuareg-run-process-if-needed org-babel-ocaml-command)
(tuareg-run-caml)))
(get-buffer tuareg-interactive-buffer-name)))
(defun org-babel-variable-assignments:ocaml (params)
"Return list of ocaml statements assigning the block's variables"
"Return list of ocaml statements assigning the block's variables."
(mapcar
(lambda (pair) (format "let %s = %s;;" (car pair)
(org-babel-ocaml-elisp-to-ocaml (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
(org-babel--get-vars params)))
(defun org-babel-ocaml-elisp-to-ocaml (val)
"Return a string of ocaml code which evaluates to VAL."
......@@ -105,37 +129,40 @@
(concat "[|" (mapconcat #'org-babel-ocaml-elisp-to-ocaml val "; ") "|]")
(format "%S" val)))
(defun org-babel-ocaml-parse-output (output)
"Parse OUTPUT.
OUTPUT is string output from an ocaml process."
(let ((regexp "%s = \\(.+\\)$"))
(cond
((string-match (format regexp "string") output)
(org-babel-read (match-string 1 output)))
((or (string-match (format regexp "int") output)
(string-match (format regexp "float") output))
(string-to-number (match-string 1 output)))
((string-match (format regexp "list") output)
(org-babel-ocaml-read-list (match-string 1 output)))
((string-match (format regexp "array") output)
(org-babel-ocaml-read-array (match-string 1 output)))
(t (message "don't recognize type of %s" output) output))))
(defun org-babel-ocaml-parse-output (value type)
"Parse VALUE of type TYPE.
VALUE and TYPE are string output from an ocaml process."
(cond
((string= "string" type)
(org-babel-read value))
((or (string= "int" type)
(string= "float" type))
(string-to-number value))
((string-match "list" type)
(org-babel-ocaml-read-list value))
((string-match "array" type)
(org-babel-ocaml-read-array value))
(t (message "don't recognize type %s" type) value)))
(defun org-babel-ocaml-read-list (results)
"Convert RESULTS into an elisp table or string.
If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
;; XXX: This probably does not behave as expected when a semicolon
;; is in a string in a list. The same comment applies to
;; `org-babel-ocaml-read-array' below (with even more failure
;; modes).
(org-babel-script-escape (replace-regexp-in-string ";" "," results)))
(defun org-babel-ocaml-read-array (results)
"Convert RESULTS into an elisp table or string.
If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-script-escape
(replace-regexp-in-string
"\\[|" "[" (replace-regexp-in-string
"|\\]" "]" (replace-regexp-in-string
"; " "," results)))))
(org-babel-script-escape
(replace-regexp-in-string
"\\[|" "[" (replace-regexp-in-string
"|\\]" "]" (replace-regexp-in-string
"; " "," results)))))
(provide 'ob-ocaml)
......
......@@ -6,12 +6,15 @@
(setq auto-mode-alist (cons '("\\.lut$" . lutin-mode) auto-mode-alist))
(setq auto-mode-alist (cons '("\\.lus$" . lustre-mode) auto-mode-alist))
(setq auto-mode-alist (cons '("\\.rif$" . rif-mode) auto-mode-alist))
(setq auto-mode-alist (cons '("\\.ml$" . tuareg-mode) auto-mode-alist))
(autoload 'rif-mode "rif" "" t)
(autoload 'lutin-mode "lutin" "Edition de code lutin" t)
(autoload 'lustre-mode "lustre" "Edition de code lustre" t)
;;(autoload 'tuareg-mode "ocaml" "" t)
(require 'org)
......@@ -35,6 +38,7 @@
(and (not (string= lang "dot")) (not (string= lang "sh"))))
(setq org-confirm-babel-evaluate 'my-org-confirm-babel-evaluate)
(mapcar #'cdr (org-babel--get-vars params))
(org-babel-do-load-languages
'org-babel-load-languages
......@@ -42,6 +46,7 @@
(ocaml . t)
(dot . t)
(lustre . t)
(lutin . t)
(rif . t)
(sh . t)
)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment