Skip to content

Latest commit

 

History

History
1119 lines (1023 loc) · 50.3 KB

literate-elisp.org

File metadata and controls

1119 lines (1023 loc) · 50.3 KB

Emacs Lisp literate library

Table of Contents

Introduction

An Emacs library or configuration file can be written in Org mode, then tangled to an Emacs Lisp file later, here is an example: Emacs configurations written in Org mode.

But what if you could load the Org file in Emacs directly? You get a uniform development environment without dealing with multiple copies of code. Furthermore, you can jump to the Emacs Lisp definition in the Org file directly when required. That will be convenient for everyday development.

Hence this library, which extends the Emacs load mechanism so Emacs can load Org files directly.

How it works

In Org mode, Emacs Lisp code is surrounded by lines between #+begin_src elisp and #+end_src (see org manual).

#+BEGIN_SRC elisp :load no
(message "this is a test.~%")
#+END_SRC

To get Emacs Lisp to read read an Org file directly, all lines except those surrounded by #+begin_src elisp and #+end_src should mean nothing, and even code surrounding by them should mean nothing if the header arguments in a code block request such behavior.

The trick is to implement a new Emacs Lisp reader function (by binding Emacs Lisp variable load-read-function) to replace the original read function when using Emacs Lisp function load to load an org file.

The new reader will make the Emacs Lisp reader enter into Org mode syntax, which means it will ignore all lines until it encounters a #+BEGIN_SRC elisp.

When a #+begin_src elisp is encountered, header arguments for this code block will give us a chance to switch back to normal Emacs Lisp reader or not.

And if it switches back to a normal Emacs Lisp reader, the end line #+END_SRC should mean the end of current code block, if it occurs, then the reader will switch back to Org mode syntax. If not, then the reader will continue to read subsequent stream as like the original Emacs Lisp reader.

Implementation

Preparation

We use Common Lisp macros, along with ob-core and subr-x functions, in this library.

(require 'cl-lib)
(require 'org)
(require 'org-src)
(require 'ob-core)
(require 'subr-x)
(require 'nadvice); required by macro `define-advice'

A debug variable to toggle log messages for this library.

(defvar literate-elisp-debug-p nil)

Debug messages can be printed with this function:

(defun literate-elisp-debug (format-string &rest args)
  "Print debug messages if `literate-elisp-debug-p' is non-nil.
Argument FORMAT-STRING: same argument of Emacs function `message',
Argument ARGS: same argument of Emacs function `message'."
  (when literate-elisp-debug-p
    (apply 'message format-string args)))

This is a dynamic Boolean variable bound by our read function while parsing is in progress. It’ll indicate whether Org mode syntax or Emacs Lisp mode syntax is in use.

(defvar literate-elisp-org-code-blocks-p nil)

And the code block begin/end identifiers:

(defvar literate-elisp-begin-src-id "#+BEGIN_SRC")
(defvar literate-elisp-end-src-id "#+END_SRC")
(defvar literate-elisp-lang-ids (list "elisp" "emacs-lisp"))

stream read functions

To analyze the syntax, we implement stream reading operations such as peek a character and read and drop next character.

The input streams are the same streams used by the original Emacs Lisp read function.

literate-elisp-peek

(defun literate-elisp-peek (in)
  "Return the next character without dropping it from the stream.
Argument IN: input stream."
  (cond ((bufferp in)
         (with-current-buffer in
           (when (not (eobp))
             (char-after))))
        ((markerp in)
         (with-current-buffer (marker-buffer in)
           (when (< (marker-position in) (point-max))
             (char-after in))))
        ((functionp in)
         (let ((c (funcall in)))
           (when c
             (funcall in c))
           c))))

literate-elisp-next

(defun literate-elisp-next (in)
  "Given a stream function, return and discard the next character.
Argument IN: input stream."
  (cond ((bufferp in)
         (with-current-buffer in
           (when (not (eobp))
             (prog1
               (char-after)
               (forward-char 1)))))
        ((markerp in)
         (with-current-buffer (marker-buffer in)
           (when (< (marker-position in) (point-max))
             (prog1
               (char-after in)
               (forward-char 1)))))
        ((functionp in)
         (funcall in))))

literate-elisp-position

This function is useful for debugging.

(defun literate-elisp-position (in)
  "Return the current position from the stream.
Argument IN: input stream."
  (cond ((bufferp in)
         (with-current-buffer in
           (point)))
        ((markerp in)
         (with-current-buffer (marker-buffer in)
           (marker-position in)))
        ((functionp in)
         "Unknown")))

literate-elisp-read-until-end-of-line

When reading an Org file character by character, if the current line is determined to be in Org syntax, then the whole line should be ignored.

Before that, let’s implement an abstract method to read characters repeatly while a predicate matches.

The ignored string return from this function because it may be useful sometimes, for example when reading header arguments after #+begin_src elisp.

(defun literate-elisp-read-while (in pred)
  "Read and return a string from the input stream, as long as the predicate.
Argument IN: input stream.
Argument PRED: predicate function."
  (let ((chars (list)) ch)
    (while (and (setq ch (literate-elisp-peek in))
                (funcall pred ch))
      (push (literate-elisp-next in) chars))
    (apply #'string (nreverse chars))))

Now reading until the end of line is easy to implement.

(defun literate-elisp-read-until-end-of-line (in)
  "Skip over a line (move to `end-of-line').
Argument IN: input stream."
  (prog1
    (literate-elisp-read-while in (lambda (ch)
                              (not (eq ch ?\n))))
    (literate-elisp-next in)))

handle Org mode syntax

code block header argument load

Source blocks in a literate program can serve a variety of purposes—implementation, examples, testing, and so on—so we define a load Org code block header argument to decide whether to read them or not, which accepts the following values -

  • yes
    The current code block should be loaded. This is the default when the header argument load is not provided.
  • no
    The current code block should be ignored.
  • test
    The current code block should load only when the variable literate-elisp-test-p is true.
  • the name of a variable or function
    The code block is loaded if the value of the variable or the return value of the function is non-nil.
    (defvar literate-elisp-test-p nil)
        

Let’s implement this behaviour.

(defun literate-elisp-load-p (flag)
  "Return non-nil if the current elisp code block should be loaded.
Argument FLAG: the value passed to the :load header argument, as a symbol."
  (pcase flag
    ((or 'yes 'nil) t)
    ('test literate-elisp-test-p)
    ;; these only seem to work on global definitions
    ((pred functionp) (funcall flag))
    ((pred boundp) flag)
    ('no nil)
    (_ nil)))

Let’s also implement a function to read header arguments after #+BEGIN_SRC elisp, and convert every key and value to a Emacs Lisp symbol (test is here:ref:test-literate-elisp-read-header-arguments).

(defun literate-elisp-read-header-arguments (arguments)
  "Reading org code block header arguments as an alist.
Argument ARGUMENTS: a string to hold the arguments."
  (org-babel-parse-header-arguments (string-trim arguments)))

Let’s define a convenient function to get load flag from the input stream.

(defun literate-elisp-get-load-option (in)
  "Read load option from input stream.
Argument IN: input stream."
  (let ((rtn (cdr (assq :load
                        (literate-elisp-read-header-arguments
                         (literate-elisp-read-until-end-of-line in))))))
    (if (stringp rtn)
      (intern rtn)
      ;; read load option from org property `literate-load'.
      (save-current-buffer
        ;; If using `poly-org-mode', then we have to switch to org buffer to access property value.
        (when (and (boundp 'poly-org-mode)
                   poly-org-mode)
          (pm-set-buffer (plist-get (cadr (org-element-context)) :begin)))
        (let ((literate-load (org-entry-get (point) "literate-load" t)))
          (when literate-load
            (intern literate-load)))))))

handle prefix spaces.

Sometimes #+begin_src elisp and #+end_src may have prefix spaces, let’s ignore them carefully.

If it is not processed correctly, the reader may enter into an infinite loop, especially when using a custom reader to tangle code.

(defun literate-elisp-ignore-white-space (in)
  "Skip white space characters.
Argument IN: input stream."
  (while (cl-find (literate-elisp-peek in) '(?\n ?\ ?\t))
    ;; discard current character.
    (literate-elisp-next in)))

alternative Emacs Lisp read function

The original Emacs read may change Emacs Lisp code, which we do not want. So we define a variable to hold the actual Emacs Lisp reader used by us. That way, it can be changed when tangling Org files (see ref:literate-elisp-tangle-reader).

(defvar literate-elisp-emacs-read (symbol-function 'read))

We don’t use the original symbol read in literate-elisp-read because sometimes the function read can be changed by the following Emacs Lisp code

(fset 'read (symbol-function 'literate-elisp-read-internal))

So we can ensure that literate-elisp-emacs-read will always use the original read function, which will not be altered when we want to byte compile the Org file by function literate-elisp-byte-compile-file.

basic read routine for Org mode syntax.

It’s time to implement the main routine to read literate org file. The basic idea is simple, ignoring all lines out of Emacs Lisp source block, and be careful about the special character #.

On the other hand, Emacs’ original read function will try to skip all comments until it can get a valid Emacs Lisp form - when we call the original read function and there are no valid Emacs Lisp forms left in the code block, it may reach #+end_src, but we can’t determine whether the original read function arrived there after a complete or incomplete parse. To avoid such a situation, we filter out all comments to ensure that the original read can always have a form to read.

(defun literate-elisp-read-datum (in)
  "Read and return a Lisp datum from the input stream.
Argument IN: input stream."

  (literate-elisp-ignore-white-space in)
  (let ((ch (literate-elisp-peek in)))
    (literate-elisp-debug "literate-elisp-read-datum to character '%s'(position:%s)."
                          ch (literate-elisp-position in))

    (cond
      ((not ch)
       (signal 'end-of-file nil))
      ((or (and (not literate-elisp-org-code-blocks-p)
                (not (eq ch ?\#)))
           (eq ch ?\;))
       (let ((line (literate-elisp-read-until-end-of-line in)))
         (literate-elisp-debug "ignore line %s" line))
       nil)
      ((eq ch ?\#)
       (literate-elisp-next in)
       (literate-elisp-read-after-sharpsign in))
      (t
       (literate-elisp-debug "enter into original Emacs read.")
       (funcall literate-elisp-emacs-read in)))))

how to handle when meet #

We have to be careful when meeting the character # and handle different conditions that may occur:

(defun literate-elisp-read-after-sharpsign (in)
  "Read after #.
Argument IN: input stream."
  ;;     if it is not inside an Emacs Lisp syntax
  (cond ((not literate-elisp-org-code-blocks-p)
         ;; check if it is `#+begin_src'
         (if (or (cl-loop for i from 1 below (length literate-elisp-begin-src-id)
                          for c1 = (aref literate-elisp-begin-src-id i)
                          for c2 = (literate-elisp-next in)
                          with case-fold-search = t
                          thereis (not (char-equal c1 c2)))
                 (while (memq (literate-elisp-peek in) '(?\s ?\t))
                   (literate-elisp-next in)) ; skip tabs and spaces, return nil
                 ;; followed by `elisp' or `emacs-lisp'
                 (cl-loop with lang = ; this inner loop grabs the language specifier
                          (cl-loop while (not (memq (literate-elisp-peek in) '(?\s ?\t ?\n)))
                                   collect (literate-elisp-next in) into rtn
                                   finally return (apply 'string rtn))
                          for id in literate-elisp-lang-ids
                          never (string-equal (downcase lang) id)))
           ;; if it is not, continue to use org syntax and ignore this line
           (progn (literate-elisp-read-until-end-of-line in)
                  nil)
           ;; if it is, read source block header arguments for this code block and check if it should be loaded.
           (cond ((literate-elisp-load-p (literate-elisp-get-load-option in))
                  ;; if it should be loaded, switch to Emacs Lisp syntax context
                  (literate-elisp-debug "enter into a Emacs Lisp code block")
                  (setf literate-elisp-org-code-blocks-p t)
                  nil)
                 (t
                  ;; if it should not be loaded, continue to use org syntax and ignore this line
                 nil))))
        (t
        ;; 2. if it is inside an Emacs Lisp syntax
         (let ((c (literate-elisp-next in)))
           (literate-elisp-debug "found #%c inside an org block" c)
           (cl-case c
             ;; check if it is ~#+~, which has only legal meaning when it is equal `#+end_src'
             (?\+
              (let ((line (literate-elisp-read-until-end-of-line in)))
                (literate-elisp-debug "found org Emacs Lisp end block:%s" line))
             ;; if it is, then switch to Org mode syntax.
              (setf literate-elisp-org-code-blocks-p nil)
              nil)
             ;; if it is not, then use original Emacs Lisp reader to read the following stream
             (t (funcall literate-elisp-emacs-read in)))))))

load/compile Org file with new syntax

literate reader is in use when loading an org file

Original function read will read until it can get a valid lisp form, we will try to keep this behavior.

(defun literate-elisp-read-internal (&optional in)
  "A wrapper to follow the behavior of original read function.
Argument IN: input stream."
  (cl-loop for form = (literate-elisp-read-datum in)
        if form
          do (cl-return form)
             ;; if original read function return nil, just return it.
        if literate-elisp-org-code-blocks-p
          do (cl-return nil)
             ;; if it reaches end of stream.
        if (null (literate-elisp-peek in))
          do (cl-return nil)))

label:literate-elisp-read Now we define the literate read function which will bind to Emacs variable load-read-function.

(defun literate-elisp-read (&optional in)
  "Literate read function.
Argument IN: input stream."
  (if (and load-file-name
           (string-match "\\.org\\'" load-file-name))
    (literate-elisp-read-internal in)
    (read in)))

And the main exported function to do literate load.

(defun literate-elisp-load (path)
  "Literate load function.
Argument PATH: target file to load."
  (let ((load-read-function (symbol-function 'literate-elisp-read))
        (literate-elisp-org-code-blocks-p nil))
    (load path)))

If you want to literate load file in batch mode, here it is:

(defun literate-elisp-batch-load ()
  "Literate load file in `command-line' arguments."
  (or noninteractive
      (signal 'user-error '("This function is only for use in batch mode")))
  (if command-line-args-left
    (literate-elisp-load (pop command-line-args-left))
    (error "No argument left for `literate-elisp-batch-load'")))

an interactive command to load a literate org file from Emacs

(defun literate-elisp-load-file (file)
  "Load the Lisp file named FILE.
Argument FILE: target file path."
  ;; This is a case where .elc and .so/.dll make a lot of sense.
  (interactive (list (read-file-name "Load org file: ")))
  (literate-elisp-load (expand-file-name file)))

a function to byte compile a literate org file

Currently(2018.12.16), Emacs bytecomp library always use function read to read Emacs Lisp forms, instead of the function specified by variable load-read-function.so we modify the symbol function of read when byte compiling org file. (This issue has been fixed in the latest Emacs, see bug 33723)

(defun literate-elisp-byte-compile-file (file &optional load)
  "Byte compile an org file.
Argument FILE: file to compile.
Arguemnt LOAD: load the file after compiling."
  (interactive
   (let ((file buffer-file-name)
	 (file-dir nil))
     (and file
	  (derived-mode-p 'org-mode)
	  (setq file-dir (file-name-directory file)))
     (list (read-file-name (if current-prefix-arg
			     "Byte compile and load file: "
			     "Byte compile file: ")
			   file-dir buffer-file-name nil)
	   current-prefix-arg)))
  (let ((literate-elisp-org-code-blocks-p nil)
        (load-file-name buffer-file-name)
        (original-read (symbol-function 'read)))
    (fset 'read (symbol-function 'literate-elisp-read-internal))
    (unwind-protect
        (byte-compile-file file)
      (when load
        (load (byte-compile-dest-file file)))
      (fset 'read original-read))))

After byte compiling a literate org file, it will be compiled to a file with suffix .org.elc, after loading such compiled file, Emacs will fail to find the variable or function definition because function find-library-name don’t treat org file as a source file, so we have to add an advice function to find-library-name to fix this issue.

(defun literate-elisp-find-library-name (orig-fun &rest args)
  "An advice to make `find-library-name' can recognize org source file.
Argument ORIG-FUN: original function of this advice.
Argument ARGS: the arguments to original advice function."

  (when (string-match "\\(\\.org\\.el\\)" (car args))
    (setf (car args) (replace-match ".org" t t (car args)))
    (literate-elisp-debug "fix literate compiled file in find-library-name :%s" (car args)))
  (apply orig-fun args))
(advice-add 'find-library-name :around #'literate-elisp-find-library-name)

compatibility with other libraries

Our next job is to make literate-elisp work with your favorite package. First, we define a function and a macro useful for adding literate-elisp support for other libraries.

(defun literate-elisp--file-is-org-p (file)
  "Return t if file at FILE is an Org-Mode document, otherwise nil."
  ;; Load FILE into a temporary buffer and see if `set-auto-mode' sets
  ;; it to `org-mode' (or a derivative thereof).
  (with-temp-buffer
    (insert-file-contents file t)
    (delay-mode-hooks (set-auto-mode))
    (derived-mode-p 'org-mode)))

(defmacro literate-elisp--replace-read-maybe (test &rest body)
  "A wrapper which temporarily redefines `read' (if necessary).
If form TEST evaluates to non-nil, then the function slot of `read'
will be temporarily set to that of `literate-elisp-read-internal'
\(by wrapping BODY in a `cl-flet' call)."
  (declare (indent 1)
           (debug (form body)))
  `(cl-letf (((symbol-function 'read)
              (if ,test
                  (symbol-function 'literate-elisp-read-internal)
                ;; `literate-elisp-emacs-read' holds the original function
                ;; definition for `read'.
                literate-elisp-emacs-read)))
     ,@body))

Then, we implement support for other libraries. These generally take the form of :around advice to functions that use read in some way (or which call functions that use read), so in those cases we will want to use the literate-elisp--replace-read-maybe macro to change read’s function definition when necessary.

support for Emacs Lisp-Refs

(defun literate-elisp-refs--read-all-buffer-forms (orig-fun buffer)
  "Around advice to make `literate-elisp' package comparible with `elisp-refs'.
Argument ORIG-FUN: the original function.
Argument BUFFER: the buffer."
  (literate-elisp--replace-read-maybe
      (literate-elisp--file-is-org-p
       (with-current-buffer buffer (symbol-value 'elisp-refs--path)))
    (funcall orig-fun buffer)))

(defun literate-elisp-refs--loaded-paths (rtn)
  "Filter return advice to prevent it from ignoring Org files.
Argument RTN: rtn."
  (append rtn
          (delete-dups
           (cl-loop for file in (mapcar #'car load-history)
                    if (string-suffix-p ".org" file)
                    collect file
                    ;; handle compiled literate-elisp files
                    else if (and (string-suffix-p ".org.elc" file)
                                 (file-exists-p (substring file 0 -4)))
                    collect (substring file 0 -4)))))

support for Helpful

The above support for elisp-refs does most of the necessary work for supporting helpful; the following is for the edge case of when helpful starts expanding macros in a source file to find a definition.

(defun literate-elisp-helpful--find-by-macroexpanding (orig-fun &rest args)
  "Around advice for `helpful--find-by-macroexpanding'.
It makes the `literate-elisp' package comparible with `helpful'.
Argument ORIG-FUN: the original function.
Argument ARGS: the arguments to original function."
  (literate-elisp--replace-read-maybe
      (literate-elisp--file-is-org-p
       (with-current-buffer (car args) buffer-file-name))
    (apply orig-fun args)))

function to tangle Org file to Emacs Lisp file

To build an Emacs Lisp file from an org file without depending on literate-elisp library, we need tangle an org file to an Emacs Lisp file(.el).

Firstly, when tangle Emacs Lisp code, we don’t want to use original Emacs read function to read them because it will ignore comment lines and it’s hard for us to revert them back to a pretty print code, so we define a new reader function and bind it to variable literate-elisp-read.

This reader will read code in a code block without changing them until it reach #+end_src.

This feature supports the additional header argument load comparing with the function org-babel-tangle in Org mode.

label:literate-elisp-tangle-reader

(defun literate-elisp-tangle-reader (&optional buf)
  "Tangling code in one code block.
Argument BUF: source buffer."
  (with-output-to-string
    (with-current-buffer buf
      (when (not (string-blank-p
                  (buffer-substring (line-beginning-position)
                                    (point))))
        ;; if reader still in last line, move it to next line.
        (forward-line 1))

      (cl-loop for line = (buffer-substring-no-properties (line-beginning-position) (line-end-position))
               until (or (eobp)
                         (string-equal (string-trim (downcase line)) "#+end_src"))
               do (cl-loop for c across line
                           do (write-char c))
               (literate-elisp-debug "tangle Emacs Lisp line %s" line)
               (write-char ?\n)
               (forward-line 1)))))

Now we can tangle the Emacs Lisp code blocks with the following code.

(cl-defun literate-elisp-tangle (&optional (file (or org-src-source-file-name (buffer-file-name)))
                                 &key (el-file (concat (file-name-sans-extension file) ".el"))
                                header tail
                                test-p)
  "Tangle org file to elisp file.
Argument FILE: target file.
Optional argument EL-FILE .
Optional argument HEADER .
Optional argument TAIL .
Optional argument TEST-P ."
  (interactive)
  (let* ((source-buffer (find-file-noselect file))
         (target-buffer (find-file-noselect el-file))
         (org-path-name (concat (file-name-base file) "." (file-name-extension file)))
         (literate-elisp-emacs-read 'literate-elisp-tangle-reader)
         (literate-elisp-test-p test-p)
         (literate-elisp-org-code-blocks-p nil))
    (with-current-buffer target-buffer
      (delete-region (point-min) (point-max))
      (when header
        (insert header "\n"))
      (insert ";;; Code:\n\n"
              ";; The code is automatically generated by function `literate-elisp-tangle' from file `" org-path-name "'.\n"
              ";; It is not designed to be readable by a human.\n"
              ";; It is generated to load by Emacs directly without depending on `literate-elisp'.\n"
              ";; you should read file `" org-path-name "' to find out the usage and implementation detail of this source file.\n\n"
              "\n"))

    (with-current-buffer source-buffer
      (save-excursion
        (goto-char (point-min))
        (cl-loop for obj = (literate-elisp-read-internal source-buffer)
                 if obj
                 do (with-current-buffer target-buffer
                      (insert obj "\n"))
                 until (eobp))))

    (with-current-buffer target-buffer
      (when tail
        (insert "\n" tail))
      (save-buffer)
      (kill-current-buffer))))

add advice to Emacs native load function

We can also add advice to load so it can load our org file automatically.

By first, let’s create a custom variable to toggle it on or off.

(defcustom literate-elisp-auto-load-org t
  "Whether load and org file from native Emacs load routine."
  :group 'literate-elisp
  :type 'boolean)

Then add an advice to load to load org file by our reader sytax.

(define-advice load
    (:around (fn &rest args) literate-elisp)
  (let ((file (car args)))
    (if (or (string-suffix-p ".org" file)
            (string-suffix-p ".org.elc" file))
      (if literate-elisp-auto-load-org
        (let ((load-read-function (symbol-function 'literate-elisp-read))
              (literate-elisp-org-code-blocks-p nil))
          (apply fn args)))
      (apply fn args))))

Now the Emacs load function can load org file in our syntax automatically.

But what will happen if we want to use Emacs Autoloading feature for an org source file? Emacs lisp routine autoload will invoke elisp routine eval-buffer to eval our org file, so let’s try to add an advice to this function to enable our reader syntax if necessary.

(define-advice eval-buffer
    (:around (fn &rest args) literate-elisp)
  (let ((buffer-file (cl-third args)))
    (if (and buffer-file
             (or (string-suffix-p ".org" buffer-file)
                 (string-suffix-p ".org.elc" buffer-file)))
      (if literate-elisp-auto-load-org
        (let ((load-read-function (symbol-function 'literate-elisp-read))
              (literate-elisp-org-code-blocks-p nil))
          (apply fn args)))
      (apply fn args))))

Now for example if you have an elisp function literate-test defined in org file literate-test.org, you can use autoload in your Emacs script like this:

(autoload 'literate-test "~/projects/literate-elisp/literate-test.org" "" nil)

We will keep the routine literate-elisp-load for the compatibility with old releases.

Release current library

And when a new version of ./literate-elisp.el can release from this file, the following code should execute.

(literate-elisp-tangle
 "literate-elisp.org"
 :header ";;; literate-elisp.el --- Load Emacs Lisp code blocks from Org files  -*- lexical-binding: t; -*-

;; Copyright (C) 2018-2019 Jingtao Xu

;; Author: Jingtao Xu <jingtaozf@gmail.com>
;; Created: 6 Dec 2018
;; Version: 0.1
;; Keywords: lisp docs extensions tools
;; URL: https://github.com/jingtaozf/literate-elisp
;; Package-Requires: ((emacs \"26.1\"))

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Literate-elisp is an Emacs Lisp library to provide an easy way to use literate programming in Emacs Lisp.
;; It extends the Emacs load mechanism so Emacs can load Org files as Lisp source files directly.
"
                 :tail "(provide 'literate-elisp)
;;; literate-elisp.el ends here
")

The head and tail lines require by MELPA repository.

Now let’s check the Emacs Lisp file to meet the requirement of MELPA.

(use-package package-lint)
(with-current-buffer (find-file "literate-elisp.el")
  (checkdoc)
  (package-lint-current-buffer))

How to insert code block in Org file

There are various ways to do it, for example you can extend the Org mode’s Easy templates to fit your needs.

I wrote a small Emacs interactive command so it can insert header arguments based on current org properties automatically. Because properties can be inherited from parent sections or whole file scope, so different default value of header arguments can be used, in a file scope, or a sub section scope.

The default header arguments to be inserted is specified in a custom variable.

(defvar literate-elisp-default-header-arguments-to-insert
    '((:name :load :property "literate-load" :desc "Source Code Load Type"
       :omit-value "yes"
       :candidates ("yes" "no" "test"))))

We try to get the header argument based on current Org property or user input.

(defun literate-elisp-get-header-argument-to-insert (argument-property-name argument-description argument-candidates)
  "Determine the current header argument before inserting a code block.
Argument ARGUMENT-PROPERTY-NAME the Org property name of the header argument.
Argument ARGUMENT-DESCRIPTION the description of the header argument.
Argument ARGUMENT-CANDIDATES the candidates of the header argument."
  (or (org-entry-get (point) argument-property-name t) ;get it from an Org property at current point.
      ;; get it from a candidates list.
      (completing-read argument-description argument-candidates)))

Let’s define a language list we want to support

(defvar literate-elisp-language-candidates
    '("lisp" "elisp" "axiom" "spad" "python" "C" "sh" "java" "js" "clojure" "clojurescript" "C++" "css"
      "calc" "asymptote" "dot" "gnuplot" "ledger" "lilypond" "mscgen"
      "octave" "oz" "plantuml" "R" "sass" "screen" "sql" "awk" "ditaa"
      "haskell" "latex" "lisp" "matlab" "ocaml" "org" "perl" "ruby"
      "scheme" "sqlite"))

Let’s determine the current literate language before inserting a code block

(defun literate-elisp-get-language-to-insert ()
  "Determine the current literate language before inserting a code block."
  (literate-elisp-get-header-argument-to-insert
   "literate-lang" "Source Code Language: "
   literate-elisp-language-candidates))

So you can define Org property literate-lang in a file scope like this in the beginning of an Org file

#+PROPERTY: literate-lang elisp

Or define it in a separate Org section with a different default value

This is a section for another literate language
:PROPERTIES:
:literate-lang: lisp
:END:

And you can also define Org property literate-load in a file scope like this in the beginning of Org file

#+PROPERTY: literate-load yes

Or define it in a separate Org section with a different default value, for example for demo section

This is a demo section so don't load code inside it
#+PROPERTY:
:PROPERTIES:
:literate-load: no
:END:

You can also specify additional header arguments to insert for current Org file in an Org property literate-header-arguments.

(defun literate-elisp-additional-header-to-insert ()
  "Return the additional header arguments string."
  (org-entry-get (point) "literate-header-arguments" t))

You can also disable this feature by an org property value in the file

(defun literate-elisp-insert-header-argument-p ()
  "Whether to insert additional header arguments."
  (not (string= "no" (org-entry-get (point) "literate-insert-header" t))))

Now it’s time to implement the insert command

(defun literate-elisp-insert-org-src-block ()
  "Insert the source code block in `org-mode'."
  (interactive)
  (let ((lang (literate-elisp-get-language-to-insert)))
    (when lang
      (insert (format "#+BEGIN_SRC %s" lang))
      (when (literate-elisp-insert-header-argument-p)
        (cl-loop for argument-spec in literate-elisp-default-header-arguments-to-insert
                 for name = (plist-get argument-spec :name)
                 for value = (literate-elisp-get-header-argument-to-insert
                              (plist-get argument-spec :property)
                              (plist-get argument-spec :desc)
                              (plist-get argument-spec :candidates))
                 if (and value (not (equal value (plist-get argument-spec :omit-value))))
                 do (insert (format " %s %s" name value))))
      (let ((additional-arguments (literate-elisp-additional-header-to-insert)))
        (when additional-arguments
          (insert " " additional-arguments)))
      (newline)
      (newline)
      (insert "#+END_SRC\n")
      (forward-line -2))))

You can bind this command to a global key in Emacs like this

(global-set-key [f2] 'literate-elisp-insert-org-src-block)

How to import source files into org subsection

Sometimes I need to import lisp source codes into an org file for an initialization of literate programming. I will re use org property LITERATE_EXPORT_PACKAGE and LITERATE_EXPORT_NAME in project literate-lisp to find out the source file then import the top level forms there in sub sections. This command is used by literate-lisp mainly for now.

get all comments and top level forms of one source file

(defun literate-elisp-comments-and-top-level-forms (source-file)
  "Get all comments and top level forms of one source file.
Argument SOURCE-FILE the path of source file."
  (with-current-buffer (find-file-noselect source-file)
    (goto-char (point-min))
    (cl-loop with items = nil
             do (unless (search-forward-regexp "^\s*[;|(|#]" nil t)
                  (setf items (nconc items (list (list :done nil nil))))
                  (cl-return items))
                (backward-char)
                (let (toplevel-type
                      toplevel-name
                      (start (point)))
                  (cond ((and (= ?\# (following-char))
                              (= ?| (char-after (1+ (point)))))
                         ;; a block of comment surround by #| and |#
                         (search-forward-regexp "^\s*|#")
                         (setf items (nconc items (list (list :block-comment nil
                                                              (buffer-substring-no-properties start (line-end-position)))))))
                        ((= ?\; (following-char))
                         (if (cl-search " -*- " (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
                             ;; This is a special comment for emacs
                             (progn
                               (goto-char (line-end-position))
                               (setf items (nconc items (list (list :special-comment-for-emacs nil
                                                                    (buffer-substring-no-properties start (line-end-position)))))))
                           ;; This is a normal comment, let's try to collect the comments lines together
                           (if (search-forward-regexp "^\s*[(|#]" nil t)
                               (backward-char)
                             (goto-char (point-max)))
                           (setf items (nconc items (list (list :comment nil
                                                                (buffer-substring-no-properties start (1- (line-beginning-position)))))))))
                        (t ;; If a top level form, let try to determine its type and end position
                         (when (= ?\# (following-char))
                           (search-forward "(")
                           (backward-char))
                         (save-excursion
                           (forward-char)
                           (setf toplevel-type (symbol-at-point))
                           (when (eq toplevel-type 'eval-when)
                             (forward-sexp 2)
                             (search-forward-regexp "^\s*(")
                             (setf toplevel-type (symbol-at-point)))
                           (search-forward-regexp "[\s|(|#|:]+")
                           (setf toplevel-name (string-trim (symbol-name (symbol-at-point)) ":")))
                         (forward-sexp 1)
                         (setf items (nconc items (list (list toplevel-type toplevel-name
                                                              (buffer-substring-no-properties start (line-end-position))))))))))))

import codes from one source file

(defun literate-elisp-import-lisp-file ()
  "Insert the Lisp source file into current section."
  (interactive)
  (let ((package-name (org-entry-get (point) "LITERATE_EXPORT_PACKAGE"))
        (source-file (org-entry-get (point) "LITERATE_EXPORT_NAME")))
    (cl-loop with last-comment = nil
             with first-code-block-p = t
             for (type name content) in (literate-elisp-comments-and-top-level-forms source-file)
             do (cond ((and (eq type 'in-package)
                            (string= package-name name))
                       ;; ignore in-package when it is the same as the default package here.
                       )
                      ((eq type :special-comment-for-emacs)
                       ;; ignore special comment line
                       )
                      ((or (eq type :comment)
                           (eq type :block-comment))
                       (setf last-comment content))
                      ((eq type :done)
                       ;; No more to add.
                       (cl-return))
                      (t
                       (if first-code-block-p
                         (progn (org-insert-subheading nil)
                                (setf first-code-block-p nil))
                         (org-insert-heading nil))
                       (insert (format "%s %s\n" type name))
                       (insert "#+BEGIN_SRC lisp\n")
                       (when last-comment
                         (insert last-comment "\n")
                         (setf last-comment nil))
                       (insert content "\n")
                       (insert "#+END_SRC\n"))))))

Tests

Introduction

We use ERT library to define and run tests. Web service travis ci will load config file ./.travis.yml to run these tests automatically every time there is a new git change.

test cases

test the empty code block

label:test-empty-code-block If one code block is empty, we will use Emacs’ original read function, which will read #+end_src and signal an error, let’s test whether literate-elisp can read it gracefully.

;; This is a comment line to test empty code block.

test code block with prefix space.

Some code blocks have white spaces before #+begin_src elisp, let’s test whether literate-elisp can read it normally.

(defvar literate-elisp-a-test-variable 10)

Let’s write a test case for above code block.

(ert-deftest literate-elisp-read-code-block-with-prefix-space ()
  "A spec of code block with prefix space."
  (should (equal literate-elisp-a-test-variable 10)))

test code block with lowercase block delimiters

Some code blocks have #+begin_src elisp and #+end_src in lowercase; let’s test whether literate-elisp can match it case-insensitively.

(defvar literate-elisp-test-variable-2 20)

Let’s write a test case for above code block.

(ert-deftest literate-elisp-read-lowercase-code-block ()
  "A spec of code block with lowercase block delimiters."
  (should (equal literate-elisp-test-variable-2 20)))

test code block with emacs-lisp instead of elisp

Some code blocks use emacs-lisp instead of the shortened elisp as the language specifier; let’s test if literate-elisp-read-after-sharpsign matches it properly.

(defvar literate-elisp-test-variable-3 30)

Let’s write a test case for the above code block.

(ert-deftest literate-elisp-read-block-with-lang-emacs-lisp ()
  "A spec of code block with the language specifier `emacs-lisp'
instead of `elisp'."
  (should (equal literate-elisp-test-variable-3 30)))

test code block with indentation

Some code blocks have indentation on the first line; let’s test whether literate-elisp can read them normally.

(defvar literate-elisp-test-variable-4 40)

Let’s write a test case for the above code block.

(ert-deftest literate-elisp-read-block-with-indentation ()
  "A spec of code block with indentation on the first line."
  (should (equal literate-elisp-test-variable-4 40)))

test literate-elisp-read-header-arguments

label:test-literate-elisp-read-header-arguments

(ert-deftest literate-elisp-read-header-arguments ()
  "A spec of function to read Org header-arguments."
  (should (equal (literate-elisp-read-header-arguments " :load yes") '((:load . "yes"))))
  (should (equal (literate-elisp-read-header-arguments " :load no  ") '((:load .  "no"))))
  (should (equal (literate-elisp-read-header-arguments ":load yes") '((:load . "yes")))))

test the :load header argument

(defun literate-elisp-test-predicate-t () t)
(defun literate-elisp-test-predicate-nil () nil)

(ert-deftest literate-elisp-test-load-argument ()
  (cl-flet ((test-header-args (string)
              (let ((tempbuf (generate-new-buffer " *temp*")))
                (unwind-protect
                    (progn
                      (with-current-buffer tempbuf
                        (insert string)
                        (goto-char 0))
                      (literate-elisp-load-p
                       (literate-elisp-get-load-option tempbuf)))
                  (kill-buffer tempbuf)))))
    (should (test-header-args " :load yes"))
    (should-not (test-header-args " :load no  "))
    (should (test-header-args ":load yes"))
    (should (test-header-args ":load literate-elisp-test-predicate-t"))
    (should-not (test-header-args ":load literate-elisp-test-predicate-nil"))))

report error message when load incomplete code block

(ert-deftest literate-elisp-test-incomplete-code-block ()
  (let ((file (make-temp-file "literate-elisp" nil ".org")))
    (with-current-buffer (find-file-noselect file)
      (insert "# start of literate syntax\n"
              "#+BEGIN_SRC elisp\n"
              "(defn test ()\n"
              " (let \n"
              ")\n"
              "#+END_SRC\n")
      (save-buffer))
    (should-error (literate-elisp-load "test/incomplete-code-block.org"))))

References