- Introduction
- The basic idea
- Preparation
- Org file parser
- Introduction
- the global variable to hold org information for current file in current point
- how to add a tokenizer for an org syntax
- how to run all patterns over each line
- head line
- how to get/set org property value
- property in a single line
- property in a properties block
- get current property value
- tangle to multiple files for one org file
- Implementation
- Release this file
- Test cases
- References
This is a Common Lisp project to show a way how to use literate programming in Common Lisp.
It extends the Common Lisp reader syntax so a Common Lisp vendor can read org files as Common Lisp source files.
literate programming examples show the reason why use org mode, and there are also another lisp project papyrus to do the similar thing but it uses markdown file format.
By using Common Lisp package literate-lisp, Emacs org mode and Emacs Lisp library polymode, literate programming can be easy in one org file containing both documentation and source codes, and this org file works well with SLIME.
In org mode, the comment line start with character # (see org manual ),
and the lisp codes exists between #+begin_src lisp and #+end_src
(see org manual, we will not support inline code block at this time).
#+BEGIN_SRC lisp :load no (format t "this is a test.~%") #+END_SRC
So to let lisp can read an org file directly, all lines out of surrounding
by #+begin_src lisp and #+end_src should mean nothing,
and even codes surrounding by them should mean nothing
if the header arguments in a code block request such behavior.
Here is a trick, a new lisp reader syntax for “# “(Sharpsign Whitespace) will have a meaning
to make lisp reader enter into org mode syntax,
then ignore all lines after that until it meet #+BEGIN_SRC lisp.
When #+begign_src lisp occurs, org header arguments for this code block give us
a chance to switch back to normal lisp reader or not.
And if it switches back to normal lisp reader, the end line #+END_SRC should mean the end of current
code block, so the lisp reader syntax for “#+”(Sharpsign Plus)will have an additional meaning
to determine if it is #+END_SRC,
if it is, then lisp reader will switch back to org mode syntax,
if it is not, lisp reader will continue to read subsequent stream as like the original lisp reader.
This workflow restricts the org file starting with a comment character and a space character(“# “), but it should not be a problem but indeed a convenient way for us to specify some local variables, for example I often put them in the first line of an org file:
# -*- encoding:utf-8 Mode: POLY-ORG; -*- ---
Which make Emacs open file with utf-8 encoding and poly-org-mode.
(defpackage :literate-lisp
(:use :cl :cl-ppcre :iterate)
(:nicknames :lp)
(:export :install-globally :tangle-org-file :with-literate-syntax)
(:documentation "a literate programming tool to write Common Lisp codes in org file."))
(pushnew :literate-lisp *features*)
(in-package :literate-lisp)(defvar debug-literate-lisp-p nil)
(declaim (type boolean debug-literate-lisp-p))And let’s define the org code block identifier.
The main purpose of this org file parser is to determine the semantics value of some property values(property syntax) in an org file.
We will use library cl-ppcre to parse each line of an org file.
(defvar current-org-context (make-hash-table))The context is based on current point in the parser.
To get a category for current context
(defun org-context (name)
(gethash name current-org-context nil))To update a category for current context
(defun set-org-context (name new-value)
(setf (gethash name current-org-context) new-value))
(defsetf org-context set-org-context)We will store a list of regex pattern in symbol lexer’s property patterns.
Each pattern will contain the following information in a list orderly:
- the name of the pattern
- the regex string to scan for each line in the org file except the source code block.
- the parameter list for registered groups in the regex string
- the handler logic codes for the pattern, it will accept parameters in section 3.
(defmacro define-lexer (name regex-pattern parameters &rest body)
(let ((fun-name (intern (format nil "ORG-LEXER-FOR-~a" name))))
`(progn (defun ,fun-name ,parameters
,@body)
(if (assoc ',name (get 'lexer 'patterns))
(setf (cdr (assoc ',name (get 'lexer 'patterns)))
(list ',fun-name ,regex-pattern ,(length parameters)))
(setf (get 'lexer 'patterns)
(nconc (get 'lexer 'patterns)
(list (list ',name ',fun-name ,regex-pattern ,(length parameters)))))))))(defun run-patterns (line)
(iter (for (name fun-name regex-pattern parameters-count) in (get 'lexer 'patterns))
(multiple-value-bind (match-start match-end reg-starts reg-ends)
(scan regex-pattern line)
(declare (ignore match-end))
(when match-start
(iter (with arguments = nil)
(for i from 0 below parameters-count)
(for start-index = (aref reg-starts i))
(setf arguments
(nconc arguments
(list (if start-index
(subseq line start-index (aref reg-ends i))
nil))))
(finally
(when debug-literate-lisp-p
(format t "apply pattern ~a with arguments ~a~%" name arguments))
(apply fun-name arguments)))
(finish)))))We will store headline in a stack, each item in this stack is a structure
(defstruct headline
;; the level
(level 0 :type integer)
;; the content
(content "" :type string)
;; the property specified for this headline
(properties (make-hash-table :test #'equalp) :type hash-table))(defun org-headlines ()
(org-context :headline))
(defun set-org-headlines (new-value)
(setf (org-context :headline) new-value))
(defsetf org-headlines set-org-headlines)(defun current-headline ()
(first (org-headlines)))(defun current-headline-level ()
(headline-level (first (org-headlines))))(defun current-headline-content ()
(headline-content (first (org-headlines))))(defun pop-org-headline ()
;; any properties in old headline may change.
(let ((old-headline (pop (org-headlines))))
(iter (for (key) in-hashtable (headline-properties old-headline))
(notify-property-value key))
old-headline))(defun push-org-headline (level content)
(push (make-headline :level level :content content) (org-headlines)))From the beginning we will construct a root head line so there will always be a headline to hold properties for the whole file.
(defun setup-headline ()
(push-org-headline 0 ""))(define-lexer :headline "^\\s*(\\*+)\\s+(.*)$"
(indicators content)
(let ((level (length indicators))
(previous-level (current-headline-level)))
(cond ((= previous-level level)
;; meet a new headline with same level, pop the old one and push the new one
(pop-org-headline)
(push-org-headline level content))
((> previous-level level)
;; meet a new headline with lower level, pop the old one until meet the same level.
(iter (pop-org-headline)
(until (< (current-headline-level) level)))
(push-org-headline level content))
(t
;; meet a new headline with higher level.
(push-org-headline level content)))
(when debug-literate-lisp-p
(format t "current headline, level:~D, content:~a~%"
(current-headline-level)
(current-headline-content)))))We will add a hook when org property value gets changed, this is useful in some conditions, for example in the progress of tangle, we want to change the target lisp file.
Please note that we only support one notifier for one property name for now.
(defmacro define-org-property-value-notifier (name value-name &rest body)
(let ((fun-name (intern (format nil "ORG-PROPERTY-VALUE-NOTIFIER-FOR-~a" name))))
`(progn (defun ,fun-name (,value-name)
,@body)
(if (assoc ',name (get 'org-property-value 'notifier) :test #'string=)
(setf (cdr (assoc ',name (get 'org-property-value 'notifier) :test #'string=))
(list ',fun-name))
(setf (get 'org-property-value 'notifier)
(nconc (get 'org-property-value 'notifier)
(list (list ,name ',fun-name))))))))(defun notify-property-value (name &optional new-value)
(let ((hook (assoc name (get 'org-property-value 'notifier) :test #'string=)))
(when hook
(when debug-literate-lisp-p
(format t "Notify new property value ~a:~a~%" name new-value))
(funcall (second hook) (or new-value (org-property-value name))))))(defun property-for-headline (headline key)
(gethash key (headline-properties headline)))(defun update-property-value (key value)
(setf (gethash key (headline-properties (current-headline))) value)
(notify-property-value key value))For example in one line of the beginning of a file like #+PROPERTY: NDisks_ALL 1 2 3 4.
(define-lexer :property-in-a-line "^\\s*\\#\\+PROPERTY:\\s*(\\S+)\\s+(.*)$"
(key value)
(when debug-literate-lisp-p
(format t "Found property in level ~D, ~a:~a.~%"
(current-headline-level) key value))
(update-property-value key value)):PROPERTIES: :Title: Goldberg Variations :Composer: J.S. Bach :Artist: Glenn Gould :Publisher: Deutsche Grammophon :NDisks: 1 :END:
We need to define three lexer to detect properties in such block.
(define-lexer :begin-of-properties "^(\\s*:PROPERTIES:\\s*)$"
(line)
(declare (ignore line))
(when debug-literate-lisp-p
(format t "Found beginning of properties.~%"))
(setf (org-context :in-properties) t))(define-lexer :end-of-properties "(^\\s*:END:\\s*$)"
(line)
(declare (ignore line))
(when (org-context :in-properties)
(when debug-literate-lisp-p
(format t "Found end of properties.~%"))
(setf (org-context :in-properties) nil)))Please note that when detect value we use no white space class so it will
not match the :PROPERTIES: and :END: which only have a key.
So it will be a unique match to all cases.
(define-lexer :property-in-properties "^\\s*:(\\S+):\\s*(\\S+.*)$"
(key value)
(when (org-context :in-properties)
(when debug-literate-lisp-p
(format t "Found property in level ~D, ~a:~a.~%"
(current-headline-level) key value))
(update-property-value key value)))(defun org-property-value (key)
(iter (for headline in (org-headlines))
(for value = (property-for-headline headline key))
(if value
(return value))))If we develop a project totally depending on literate-lisp, there are no need to tangle it into lisp files,
we can use org files as both document and codes as we already have did.
But unfortunately this is not true in most conditions, especially in a lisp team.
At this time, the tangle feature will become more important to us.
If we can generate target lisp files just like a normal lisp project, for example a file package.lisp for package definition
and each module as an individual lisp file, than the tangled files will be more clear to other people.
To achieve such goal, we will use a new org property LITERATE_EXPORT_NAME to indicate target file to tangle for code block
in point, and open target file when this property gets changed.
We also introduce org property LITERATE_EXPORT_PACKAGE to add a in-package lisp form in the beginning of tangled file
if it is specified. Please note that you have to put this property before LITERATE_EXPORT_NAME.
(defvar *tangle-org-file* nil)We will only open file as stream when it is in a tangle, so this variable is also useful for this purpose
(defun tangle-p ()
*tangle-org-file*)(defvar *tangle-head-lines* nil)We will store them in a global variable
(defvar *tangle-streams* (make-hash-table :test #'equal))Each stream will have a default external format and default element type, we will re-use the configuration
from ASDF, which is uiop:*default-encoding* and uiop:*default-stream-element-type*.
To get path for a name
(defun path-for-literate-name (name)
(cl-fad:merge-pathnames-as-file *tangle-org-file* name))Because now we manage files streams in many place, so it is necessary as a global special variable.
(defvar *check-outside-modification-p* nil)To get a stream for a name
(defun tangle-stream (name)
(or (gethash name *tangle-streams*)
(let ((output-file (path-for-literate-name name)))
(when (and *check-outside-modification-p*
(tangled-file-update-outside-p output-file))
(restart-case
(error "The output file ~a has been updated outside, please merge it into your org file before tangling!" output-file)
(override ()
:report (lambda (stream)
(format stream "Override the file with name '~a'!" (pathname-name output-file))))))
(let ((stream (open output-file
:direction :output
:element-type uiop:*default-stream-element-type*
:external-format uiop:*default-encoding*
:if-does-not-exist :create
:if-exists :supersede)))
(when *tangle-head-lines*
(write-string *tangle-head-lines* stream))
(let ((package (org-property-value "LITERATE_EXPORT_PACKAGE")))
(when package
(format stream "(in-package #:~a)~%~%" package)))
(setf (gethash name *tangle-streams*) stream)))))To close all open streams
(defun cleanup-tangle-streams ()
(iter (for (name stream) in-hashtable *tangle-streams*)
(close stream)
(cache-tangled-file (path-for-literate-name name)))
(clrhash *tangle-streams*))We will store current file stream in a special variable
(defvar *current-tangle-stream* nil)And update it when a new value arrivals.
(define-org-property-value-notifier "LITERATE_EXPORT_NAME" name
(when (and (tangle-p) name)
(setf *current-tangle-stream*
(tangle-stream name))))Let’s implement a function to read header arguments after #+BEGIN_SRC lisp,
and convert every key and value to a lisp keyword(Test in here: ref:test-read-keywords-from-string).
Please note that if a keyword starts with -, then it will return as not feature.
This is trick to use #-feature, and we should design it with new syntax later, to fit with
all possible feature expressions.
(defun read-keywords-from-string (string &key (start 0))
(with-input-from-string (stream string :start start)
(let ((*readtable* (copy-readtable nil))
(*package* #.(find-package :keyword))
(*read-suppress* nil))
(iter (for minus-p = (when (char= #\- (peek-char t stream nil #\Space))
(read-char stream)
t))
(for elem = (read stream nil))
(while elem)
(collect (if minus-p
(cons elem :not)
elem))))))There are a lot of different lisp codes occur in one org file, some for function implementation,
some for demo, and some for test, so a new org code block header argument load to decide to
read them or not should define, and it has three meanings:
- yes
It means that current code block should load normally, it is the default mode when the header argumentloadis not provided. - no
It means that current code block should ignore by lisp reader. - other feature keyword registered in global variable
*features*
So you can take advantage of*features*to load your codes by various purposes. - If a feature keyword start with -, it will load if this feature is not in
*features*
(defun load-p (feature)
(cond ((eq :yes feature)
t)
((eq :no feature)
nil)
((null feature)
;; check current org property `literate-load'.
(let ((load (org-property-value "literate-load")))
(when debug-literate-lisp-p
(format t "get current property value of literate-load:~a~%" load))
(if load
(load-p (first (read-keywords-from-string load)))
t)))
((consp feature)
;; the feature syntax is ` (feature . :not)'.
(if (eq :not (cdr feature))
(not (find (car feature) *features* :test #'eq))))
(t (find feature *features* :test #'eq))))Now it’s time to implement the new reader function for syntax “# “(# + Space).
We have to check whether current line is a #+begin src lisp.
Additionally, we will ignore space characters in the beginning of line, let’s find the position of it by a function.
(defun start-position-after-space-characters (line)
(iter (for c in-sequence line)
(for i from 0)
(until (not (find c '(#\Tab #\Space))))
(finally (return i))))The reader syntax will
- record all named blocks except loadable lisp code blocks as global lisp varaibles.
- ignore other lines until meet a
#+begin_src lispand header argumentloadis true.
(defvar org-lisp-begin-src-id "#+begin_src lisp")
(defvar org-name-property "#+NAME:")
(defvar org-name-property-length (length org-name-property))
(defvar org-block-begin-id "#+BEGIN_")
(defvar org-block-begin-id-length (length org-block-begin-id))
(defun sharp-space (stream a b)
(declare (ignore a b))
;; reset org content in the beginning of the file;
;; here we assume sharp space meaning it.
(setf current-org-context (make-hash-table))
(setup-headline)
(sharp-org stream))
(defun sharp-org (stream)
(let ((named-code-blocks nil))
(iter (with name-of-next-block = nil)
(for line = (read-line stream nil nil))
(until (null line))
(for start1 = (start-position-after-space-characters line))
(when debug-literate-lisp-p
(format t "ignore line ~a~%" line))
(run-patterns line)
(until (and (equalp start1 (search org-lisp-begin-src-id line :test #'char-equal))
(let* ((header-arguments (read-keywords-from-string line :start (+ start1 (length org-lisp-begin-src-id)))))
(load-p (getf header-arguments :load)))))
(cond ((equal 0 (search org-name-property line :test #'char-equal))
;; record a name.
(setf name-of-next-block (string-trim '(#\Tab #\Space) (subseq line org-name-property-length))))
((equal 0 (search org-block-begin-id line :test #'char-equal))
;; record the context of a block.
(if name-of-next-block
;; start to read text in current block until reach `#+END_'
(when (load-p nil); check whether load this named code block based on `*features*'.
(let* ((end-position-of-block-name (position #\Space line :start org-block-begin-id-length))
(end-block-id (format nil "#+END_~a" (subseq line org-block-begin-id-length end-position-of-block-name)))
(block-stream (make-string-output-stream)))
(when (read-block-context-to-stream stream block-stream name-of-next-block end-block-id)
(setf named-code-blocks
(nconc named-code-blocks
(list (cons name-of-next-block
(get-output-stream-string block-stream))))))))
;; reset name of code block if it's not sticking with a valid block.
(setf name-of-next-block nil)))
(t
;; reset name of code block if it's not sticking with a valid block.
(setf name-of-next-block nil))))
(if named-code-blocks
`(progn
,@(iter (for (block-name . block-text) in named-code-blocks)
;; evaluate this parameter earlier so we can use it in a macro in current file.
(for code = `(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter ,(intern (string-upcase block-name)) ,block-text)))
(when *current-tangle-stream*
(write-line "" *current-tangle-stream*)
(write code :stream *current-tangle-stream*)
(write-line "" *current-tangle-stream*))
(collect code)))
;; Can't return nil because ASDF will fail to find a form like `defpackage'.
(values))))(defun read-block-context-to-stream (input-stream block-stream block-name end-block-id)
(iter (for line = (read-line input-stream nil))
(cond ((null line)
(return nil))
((string-equal end-block-id (string-trim '(#\Tab #\Space) line))
(when debug-literate-lisp-p
(format t "reach end of block for '~a'.~%" block-name))
(return t))
(t
(when debug-literate-lisp-p
(format t "read line for block '~a':~s~%" block-name line))
(write-line line block-stream)))))This code block reference from the SBCL source codes with some minor modifications. It implements how to do feature test.
Allegro Lisp has extended the syntax for feature test, and
LispWorks has different behavior, for example it will not report an error
when there is additional argument in feature expression
(for example (not lispworks 6)).
For these two vendors, we will use their own feature test function.
;;; If X is a symbol, see whether it is present in *FEATURES*. Also
;;; handle arbitrary combinations of atoms using NOT, AND, OR.
(defun featurep (x)
#+allegro(excl:featurep x)
#+lispworks(sys:featurep x)
#-(or allegro lispworks)
(typecase x
(cons
(case (car x)
((:not not)
(cond
((cddr x)
(error "too many subexpressions in feature expression: ~S" x))
((null (cdr x))
(error "too few subexpressions in feature expression: ~S" x))
(t (not (featurep (cadr x))))))
((:and and) (every #'featurep (cdr x)))
((:or or) (some #'featurep (cdr x)))
(t
(error "unknown operator in feature expression: ~S." x))))
(symbol (not (null (member x *features* :test #'eq))))
(t
(error "invalid feature expression: ~S" x))))The mechanism to handle normal lisp syntax “#+” is also referenced from SBCL source codes.
Let’s read the feature value after #+ as a keyword
(defun read-feature-as-a-keyword (stream)
(let ((*package* #.(find-package :keyword))
;;(*reader-package* nil)
(*read-suppress* nil))
(read stream t nil t)))And if feature is END_SRC, switch back to org mode syntax
(defun handle-feature-end-src (stream sub-char numarg)
(declare (ignore sub-char numarg))
(when debug-literate-lisp-p
(format t "found #+END_SRC,start read org part...~%"))
(funcall #'sharp-org stream))if feature is available, read the following object recursively.
(defun read-featurep-object (stream)
(read stream t nil t))If the feature doesn’t exist, read the following object recursively and ignore it.
(defun read-unavailable-feature-object (stream)
(let ((*read-suppress* t))
(read stream t nil t)
(values)))And the new logic to handle lisp syntax “#+”:
(defun sharp-plus (stream sub-char numarg)
(let ((feature (read-feature-as-a-keyword stream)))
(when debug-literate-lisp-p
(format t "found feature ~s,start read org part...~%" feature))
(cond ((eq :END_SRC feature) (handle-feature-end-src stream sub-char numarg))
((featurep feature) (read-featurep-object stream))
(t (read-unavailable-feature-object stream)))))We will install the reader syntax globally if the feature literate-global presents.
(defun install-globally ()
(set-dispatch-macro-character #\# #\space #'sharp-space)
(set-dispatch-macro-character #\# #\+ #'sharp-plus))
#+literate-global(install-globally)Otherwise, we will limit the scope of the new reader syntax in a specified code body, by installing it before a code body and uninstalling it after this code body.
(defmacro with-literate-syntax (&body body)
`(let ((*readtable* (copy-readtable)))
;; install it in current readtable
(set-dispatch-macro-character #\# #\space #'literate-lisp::sharp-space)
(set-dispatch-macro-character #\# #\+ #'literate-lisp::sharp-plus)
,@body))Now you can use named-readtables to define the syntax for literate-lisp
#+named-readtables
(named-readtables:defreadtable literate-lisp
(:merge :standard)
(:dispatch-macro-char #\# #\space #'sharp-space)
(:dispatch-macro-char #\# #\+ #'sharp-plus))To build lisp file from an org file, we implement a function tangle-org-file.
- Argument
org-fileis the source org file. - Argument
featureis a feature list to indicate the features used to tangle, the default is*features*. - Argument
headeris the header string to print out in the begging of tangled lisp file - Argument
header-argsis the format arguments used byheader, they will be sent to formatformat. - Argument
force-tangleindicate whether overwrite lisp file even it is updated outside. - Arguments
output-fileis the target lisp file.
The basic method is simple here, we use function sharp-space to ignore all lines should be ignored,
then export all code lines until we reach #+end_src, this process is repeated to end of org file.
This mechanism is good enough because it will not damage any codes in org code blocks.
This feature supports the additional header argument load comparing with the function org-babel-tangle in org mode.
(defun tangle-org-file (org-file &key (features *features*)
(header ";;; This file is automatically generated from file `~a.~a'.
;;; Please read file `~a.~a' to find out the usage and implementation detail of this source file.~%~%")
(header-args (list (pathname-name org-file) (pathname-type org-file)
(pathname-name org-file) (pathname-type org-file)))
(force-tangle nil)
(output-name (format nil "~a.lisp" (pathname-name org-file))))
(let ((*features* features)
(*tangle-org-file* org-file)
(*current-tangle-stream* nil)
(*tangle-head-lines* (apply #'format nil header header-args))
(*check-outside-modification-p* (not force-tangle))
;; reset org context
(current-org-context (make-hash-table)))
(setup-headline)
(when output-name
(setf *current-tangle-stream* (tangle-stream output-name)))
(with-open-file (input org-file :direction :input
:element-type uiop:*default-stream-element-type*
:external-format uiop:*default-encoding*)
(block read-org-files
(iter
;; ignore all lines of org syntax.
(sharp-org input)
;; start to read codes in code block until reach `#+END_SRC'
(if (read-block-context-to-stream input *current-tangle-stream* "LISP" "#+END_SRC")
(write-line "" *current-tangle-stream*)
(return)))))
(cleanup-tangle-streams)
t))Sometimes we delivered our org file to a lisp file and this lisp file may be updated outside. In this condition we will not tangle to this lisp file, in case overritting the update.
To detect such update, we will tangle the lisp file into local cache directory and only tangle to this file again if the target lisp file is the same one with the cached one.
(defun tangled-cached-file (path)
(translate-pathname (asdf/driver:resolve-absolute-location path)
#P"/**/*.*"
(merge-pathnames "literate-lisp/**/*.*" (asdf/driver:xdg-cache-home))))(defun tangled-file-update-outside-p (file)
(let ((cache-file (tangled-cached-file file)))
(when (and (probe-file cache-file); It has never been tangled yet.
(probe-file file))
(string/= (uiop:read-file-string file)
(uiop:read-file-string cache-file)))))(defun cache-tangled-file (file)
(let ((cache-file (tangled-cached-file file)))
(ensure-directories-exist cache-file)
(uiop:copy-file file cache-file)))Now let’s add literate support to ASDF system.
Firstly a new source file class for org files should define in ASDF package.
(in-package :asdf)
(eval-when (:compile-toplevel :load-toplevel :execute)
(export '(asdf::org) :asdf))
(defclass asdf::org (asdf:cl-source-file)
((asdf::type :initform "org")))So a new ASDF source file type :org can define an org file like this
(asdf:defsystem literate-demo
:components ((:module demo :pathname "./"
:components ((:org "readme"))))
:depends-on (:literate-lisp))And file readme.org will load as a lisp source file by ASDF.
Then the new reader syntax for org file installs when ASDF actions perform to every org file.
(defmethod asdf:perform :around (o (c asdf:org))
(literate-lisp:with-literate-syntax
(call-next-method)))Then after loading this package, one org file can load by ASDF automatically.
Additionally, the ASDF package-inferred-system extension will try to define a system dynamically by reading package related forms in a source file,to make it can handle ORG syntax, we have to install it around it. The system is created in function sysdef-package-inferred-system-search in file package-inferred-system.lisp. But we have to add our literate syntax in an parent method, here we choose the method asdf/system:find-system
(defmethod asdf/system:find-system :around (name &optional (error-p t))
(declare (ignore name error-p))
(literate-lisp:with-literate-syntax
(call-next-method)))So to use org source files in a package inferred system, we can write an ASD definition like this:
(asdf:defsystem literate-libraries
:serial t
:defsystem-depends-on (:literate-lisp)
:default-component-class :org
:class :package-inferred-system)Switch back from asdf package to our package.
(in-package :literate-lisp)For sly, it allows registering a routine to compile and load files on the Lisp side like this.
(defun literate-compile-file-for-emacs (pathname &rest args)
(if (string= "st" (pathname-type pathname))
(funcall (intern "TALK-INTERPRET" :talk) (uiop:read-file-string (namestring pathname)))
(literate-lisp:with-literate-syntax
(apply 'slynk::slynk-compile-file* pathname args))))
(pushnew 'literate-compile-file-for-emacs slynk::*compile-file-for-emacs-hook*)This is most effective method for incorporating literate lisp because it does not alter the original compile and load routines in Common Lisp, thus maintaining their intended behavior.
LispWorks can add an advice to a function to change its default behavior, we can take advantage of
this facility to make function load can handle org file correctly.
#+lispworks
(lw:defadvice (cl:load literate-load :around) (&rest args)
(literate-lisp:with-literate-syntax
(apply #'lw:call-next-advice args)))In sbcl, we can redefine the load function by this way:
(defvar original-load-function #'load)
(defun literate-load (&rest args)
(literate-lisp:with-literate-syntax
(apply original-load-function args)))
(setf (fdefinition 'load) #'literate-load)(tangle-org-file
(format nil "~aliterate-lisp.org"
(asdf:component-pathname (asdf:find-system :literate-lisp)))
:output-name nil
;; :force-tangle t
:features (cons :test *features*))Now it’s time to validate some functions. The FiveAM library is used to test.
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package :fiveam)
#+quicklisp (ql:quickload :fiveam)
#-quicklisp (asdf:load-system :fiveam)))
(5am:def-suite literate-lisp-suite :description "The test suite of literate-lisp.")
(5am:in-suite literate-lisp-suite)label:test-read-keywords-from-string
(5am:test read-keywords-from-string
(5am:is (equal nil (read-keywords-from-string "")))
(5am:is (equal '(:load :no) (read-keywords-from-string " :load no ")))
(5am:is (equal '(:load (:no . :not)) (read-keywords-from-string " :load -no ")))
(5am:is (equal '(:load :no) (read-keywords-from-string " :load no"))))(5am:test protect-tangled-file
(5am:signals (error "The form ~S is expected to signal an ~S"
'(error "an error") 'error)
(let* ((org-file (format nil "~a/readme.org"
(asdf:component-pathname (asdf:find-system :literate-lisp))))
(lisp-file (make-pathname :defaults org-file :type "lisp")))
(tangle-org-file org-file)
(with-open-file (stream lisp-file :direction :output)
(write-line ";; Update lisp file outside." stream))
(tangle-org-file org-file))))this function is the entry point to run all tests and return true if all test cases pass.
(defun run-test ()
(5am:run! 'literate-lisp-suite))To run all tests in demo project literate-demo, please load it by yourself.
- Literate. Programming by Donald E. Knuth
- Literate Programming a site of literate programming
- Literate Programming in the Large a talk video from Timothy Daly, one of the original authors of Axiom.
- literate programming in org babel
- A collection of literate programming examples using Emacs Org mode
- papyrus A Common Lisp Literate Programming Tool in markdown file