Lenticular Text For Emacs

Next:   [Contents]

Lenticular Text For Emacs

Table of Contents


1 Introduction

This package implements lenticular text: simultaneous editing and viewing of the same (or closely related) text in two or more buffers. While lentic has many potential uses it also enables a form of literate programming. This is the literate documentation for lentic.

Documentation for each package is organised according to approximate usage in documentation terms. So the core package (lentic) comes first, then that associated with the mode, and then a package which is useless but good for understanding how to configure lentic for new environments.


1.1 Caveat

The general idea of using lentic to document itself is a good one; I think the general principle of dogfooding making sense. It has a disadvantage, though. At the moment, lentic is not finished, nor is the transformation that I am using to generate the documentation. So, the output is currently not ideal; this makes it both harder to read than ideal, nor the best advert for lentic.

It will improve!


2 Getting Started

In this section, I describe how to use one particular use of lentic – translating between Emacs-Lisp and Org-mode. This is not the only use of lentic as it neither specific to Emacs-Lisp nor Org-mode, but it’s an easy one to get started with.


2.1 Installing

Lentic can be installed from GNU ELPA, e.g. with M-x list-packages. Once "lentic" is installed, type M-x global-lentic-mode.


2.2 With existing lentic source

The easiest way to use lentic is with source which is already formatted appropriately for lentic, including the source code for lentic.

First, clone the lentic repository. This contains a .dir-locals.el file, in addition to the source, which tells lentic how to create a lentic-buffer.

git clone https://github.com/phillord/lentic.git

Now, open lentic.el in Emacs. You should get prompted to accept a unsafe directory local variable. If you trust me, then type "y" or "!".

To create the lentic buffer, press C-c,c or "Edit->Lentic->Create All", followed by C-c,b or "Edit->Lentic->Split Below" to show both Emacs-Lisp and Org-mode file at the same time.


2.3 Converting legacy source

To convert some an existing source file called, say, blah.el into a lentic file.

  • Add ;; #+BEGIN_SRC emacs-lisp after introductory comments but before any source.
  • Add ;; #+END_SRC as the last line.
  • Before the file header (if you have one!), add ;;; Header:
  • Add a .dir-local.el as follows:
((emacs-lisp-mode
  (lentic-init . lentic-orgel-org-init)))

You should now have something like this:

;;; blah.el --- stuff, stuff stuff

;;; Header:

;; This file is not part of Emacs

;;; Code:

;; #+BEGIN_SRC emacs-lisp
(provide 'blah)
;; #+END_SRC

Your buffer should now be set up for lentic. Either close and reopen or type M-x revert-buffer to ensure ‘lentic-init’ has been configured.

To add documentation, I make heavy use of ‘org-babel-demarcate-block’ to split the single large Emacs-Lisp code blocks into smaller blocks as I go. The whole buffer remains properly formatted throughout this way.


3 Lentic

lentic.el is the central point of this package. It provides the base configuration options, the hooks into emacs change notification and the default transformation (which copies text exactly).


Next: , Previous: , Up: Lentic   [Contents]

3.2 Commentary

‘lentic’ enables lenticular text: simultaneous editing and viewing of the same (or closely related) text in two or more buffers, potentially in different modes. Lenticular text is named after lenticular printing, which produce images which change depending on the angle at which they are viewed.

Sometimes, it would be nice to edit a file in two ways at once. For instance, you might have a source file in a computational language with richly marked documentation. As Emacs is a modal editor, it would be nice to edit this file both in a mode for the computational language and for the marked up documentation.

One solution to this is to use a single-mode which supports both types of editing. The problem with this is that it is fundamentally difficult to support two types of editing at the same time; more over, you need a new mode for each combination. Another solution is to use one of the multiple-mode tools which are available. The problem with this is that they generally need some support from the modes in question. And, again, the difficulty is supporting both forms of editing in the same environment. A final problem is that it is not just the editing environment that needs to be adapted; the programmatic environment needs to be untroubled by the documentation, and the documentation environment untroubled by the program code.

Lenticular text provides an alternative solution. Two lentic buffers, by default, the share content but are otherwise independent. Therefore, you can have two buffers open, each showing the content in different modes; to switch modes, you simply switch buffers. The content, location of point, and view are shared.

Moreover, lentic buffers can also perform a bi-directional transformation between the two. If this is done, then the two can have different but related text. This also solves the problem of integration with a tool-chain; each lentic buffer can be associated with a different file and a different syntax. For example, this file is, itself, lenticular text. It can be viewed either as Emacs-Lisp or in Org-Mode. In Emacs-Lisp mode, this text is commented out, in org-mode it is not.

In fact, although the default behaviour of lentic appears to keep the same text in each buffer, even it uses this bi-directional transformation capability; while the text is shared, the text properties are not. This is a behaviour which differs between lentic buffers and indirect buffers. The lentic buffers can therefore be in different modes without fighting each other to set the text properties.

It is possible to configure the transformation for any two buffers in a extensible way. Mostly I have concentrated on mode-specific operation, but, for instance, I have also used this ability on a per-project basis controlling, for instance, the location of the lentic-file.


Next: , Previous: , Up: Lentic   [Contents]

3.3 Usage

lentic can be installed from GNU ELPA/Marmalade then add

(global-lentic-mode 1)

to your init file.

The main user entry points are accessible through the lentic edit menu, or through ‘global-lentic-mode’ which adds keybindings to create and manipulate new lentic buffers. See ‘lentic-mode’ commentary for more information.

By default, the lentic buffer created contains exactly the same contents as the original buffer, but is otherwise separate; it can have a different major modes, different syntax highlighting, invisible regions and even different narrowing. Saving one buffer will save the other; killing the lentic buffer does not affect the original, but killing the original also kills the lentic.

While this is somewhat useful, more generally a buffer will be configured to produce a particular transformation. This can control many features of the lentic, including the file name, major mode and an arbitrary transformation between the two. Configuration is considered next.


Next: , Previous: , Up: Lentic   [Contents]

3.4 Configuration

lentic buffers are configurable in a large number of ways. It is possible to control the nature of the transformation, the default buffer name that a lentic buffer takes, and the file location (or not) of the lentic buffer. Lentic now supports any number of lentic buffers, in relatively arbitrary geometries, although this requires additional support from the configuration objects.

Configuration of a buffer happens in one of two places. First, ‘lentic-init’ is run when a lentic buffer is first created. This function should return the configuration object, and is mostly designed for use as a file-local or dir-local variable. This object is stored in the ‘lentic-config’ and all subsequent operation happens through this.

There are now a number of different configurations, which can be used for general-purposes use as well as an extension points for subclass configurations. The two most general configurations are:

  • default: this copies all text exactly, but does not transfer text-properties (which is the behaviour of indirect buffers). It is possible to configure the default file or mode on a per-object basis.
  • chunk: this is designed for programmatic syntaxes where chunks of code are demarcated by start and end tags, and everything else is commented by line-start comments. Comments are added or removed between the two buffers.

The second of these is extended in lentic-org.el to provide the configuration for this file: there is a normal emacs-lisp file in one buffer and an org-mode version in another. Other programmatic and documentation modes are supported in other files.


Next: , Previous: , Up: Lentic   [Contents]

3.5 Status

This is a beta release, but is now nearly feature complete. The core lentic libraries should hopefully be fairly stable now, however, there is the possibility that it will behave badly and may result in data loss. Please use with care on files with backups.

Previous releases of this package were called "linked-buffer". I changed this because I wanted a name for the general idea of text with two visualisations; "linked text" doesn’t work because it is sounds like hyperlinked text.

Although it is still too early to guarantee, I hope that the current configuration scheme will remain fixed, and subclass extensions should require little change for the future.


Previous: , Up: Lentic   [Contents]

3.6 Code

(require 'eieio)
(require 'm-buffer)
(require 'm-buffer-at)
(require 'dash)

(defvar lentic-doc "lenticular.org")
(defvar lentic-doc-html-files '("lenticular.css"))

Next: , Up: Code   [Contents]

3.6.1 State

This section defines all of the variables that the basic state for lentic is stored in. We deliberately have as few of these as possible, as this makes re-initializing the state during development as straight-forward as possible.

We start with ‘lentic-init’ which provides the ability to define some default configuration for a buffer. These are just functions which return ‘lentic-configuration’ objects. This is a slight step of indirection but is essentially there to allow the use of file- or dir-local variables to define the default behaviour for a given buffer. All the values have to be defined by the user as safe, so we do not want too many different values.

(defvar lentic-init nil
  "Function that initializes lentics for this buffer.

This should be one or a list of functions that each return a
`lentic-configuration' object.")

(make-variable-buffer-local 'lentic-init)

The ‘lentic-config’ variable stores all of the configuration objects for each lentic-buffer of this-buffer. Each lentic-buffer should have one configuration object and is this configuration object that controls the behaviour and updating of that lentic. As lentics are bi-directional, the ‘lentic-config’ variable should be – for each lentic-configuration object in this-buffer pointing to that-buffer there should be one in that-buffer pointing to this-buffer. This variable has to ‘permanent-local’ otherwise a new mode (or typing ‘normal-mode’) would break everything.

(defvar lentic-config nil
  "Configuration for lentic.

This is a list of objects of the class `lentic-configuration'
lentic-configuration', which defines the way in which the text in
the different buffers is kept synchronized. This configuration is
resilient to changes of mode in the current buffer.")

(make-variable-buffer-local 'lentic-config)
(put 'lentic-config 'permanent-local t)

(defvar lentic-counter 0)
(defun lentic-config-name (buffer)
  "Given BUFFER, return a name for the configuration object."
  (format "lentic \"%s:%s\"" buffer (setq lentic-counter (+ 1 lentic-counter))))

;;;###autoload
(defvar lentic-init-functions nil
  "All functions that can be used as `lentic-init' function.")

Next: , Previous: , Up: Code   [Contents]

3.6.2 Base Configuration

This section defines the base class and generic methods for all lentic-configuration objects. Most of the properties of this class define the behaviour of the lentic-buffer – in other words they are configuration. However, there are a few properties which store state about the last before-change event that occured which are used to percolate the changes correctly. This is a handy place to store these, but are not really end-user properties.

(defclass lentic-configuration ()
  ((this-buffer
    :initarg :this-buffer
    :documentation
    "The this-buffer for this configuration. This should be the
    current-buffer when this configuration is present in `lentic-config'." )
   (that-buffer
    :initarg :that-buffer
    :documentation
    "The that-buffer for this configuration. The that-buffer (if
    live) should a lentic-configuration object for this-buffer in
    its `lentic-config'." )
   (creator
    :initarg :creator ;; FIXME: Not used.
    :initform nil
    :documentation
    "Non-nil if this lentic-configuration was used to create a
    lentic view. This is used to determine the behaviour when the
    buffer is killed: killing the creator kills all views, but killing
    a view does not kill the creator.")
   (delete-on-exit
    :initarg :delete-on-exit
    :initform nil
    :documentation
    "Non-nil if the file associated with this should be deleted on exit.")
   (singleton ;; FIXME: Not used?
    :initarg :singleton
    :initform nil
    :documentation
    "Non-nil if only one lentic (and therefore object) of this type
    can exist for a given buffer.")
   (sync-point
    :initarg :sync-point
    :initform t
    :documentation
    "Non-nil if changes to the location of point in this-buffer
    should be percolated into that-buffer.")
   (last-change-start
    :initarg :last-change-start ;; FIXME: Not used.
    :initform nil
    :documentation
    "The location of the start of the last before-change event.
    This should only be set by lentic.")
   (last-change-start-converted
    :initarg :last-change-start-converted ;; FIXME: Not used.
    :initform nil
    :documentation
    "The location of the start of the last before-change event,
    converted into the equivalent location in that-buffer. This
    should only be set by lentic.")
   (last-change-stop
    :initarg :last-change-stop ;; FIXME: Not used.
    :initform nil
    :documentation
    "The location of the stop of the last before-change event.
    This should only be set by lentic." )
   (last-change-stop-converted
    :initarg :last-change-stop-converted ;; FIXME: Not used.
    :initform nil
    "The location of the stop of the last before-change event,
    converted into the equivalent location in that-buffer. This
    should only be set by lentic."))
  "Configuration object for lentic which defines the behavior of
  the lentic buffer.")

We define a set of generic methods. I am not entirely sure what the purpose of generic methods are and whether I need them or not; I think it’s just a place to put the documentation.

(cl-defgeneric lentic-create (conf)
  "Create the lentic for this configuration.
Given a `lentic-configuration' object, create the lentic
appropriate for that configurationuration. It is the callers
responsibility to check that buffer has not already been
created.")

(cl-defgeneric lentic-convert (conf location)
  "Convert LOCATION in this-buffer to an equivalent location in
that-buffer. LOCATION is a numeric location, rather than a
marker. By equivalent, we mean the same semantic location as
determined by the transformation between the buffers. It is
possible that a given LOCATION could map to more than one
location in the lentic buffer.")

(cl-defgeneric lentic-clone (conf)
  "Updates that-buffer to reflect the contents in this-buffer.

Updates at least the region that has been given between start and
stop in the this-buffer, into the region start-converted and
stop-converted in that-buffer.

Returns a list of the start location in that-buffer of the
change, the stop location in that-buffer of the change and the
length-before in that buffer of the region changed before the
change, if and only if the changes are exactly that suggested by
the START, STOP, _LENGTH-BEFORE, START-CONVERTED and
STOP-CONVERTED. Otherwise, this should return nil.")

We need an invert method because we can create the configuration object for a this-buffer without actually creating that-buffer. This may happen at any point in the future. So, the configuration object needs to be able to return it’s own inverse. This can be a configuration object of the same class which is normal when the lentic transformation is symmetrical, or a different class which is normal when the lentic transformation is asymmetrical.

(cl-defgeneric lentic-invert (conf)
  "Return a new configuration object for the lentic buffer.
This method is called at the time that the lentic is created. It
is the callers responsibility to ensure that this is only called
at creation time and not subsequently. The invert function should
only return the configuration object and NOT create the lentic
buffer.")

‘lentic-coexist?’ has been created to cope with the case when a buffer has two or more default views. We may wish to re-initialize all the default lentic views. However, this is going to be problematic if some are already there – we will end up with two many. In general, configurations which have been created as a result of calls to the ‘lentic-init’ functions should return false here if there is another call to the same function. Lentic buffers which are being used as a persistent view should generally return true here so that as many can be created as required.

(cl-defgeneric lentic-coexist? (this-conf that-conf)
  "Return non-nil if THIS-CONF and co-exist with THAT-CONF.
By co-exist this means that both configurations are valid for a
given buffer at the same time. A nil return indicates that there
should only be one of these two for a given buffer.")

I’ve implemented ‘lentic-this’ and ‘lentic-that’ as methods although I think I have only over-ridden the implementation once in lentic-delayed which has since been deleted anyway.

(cl-defmethod lentic-this ((conf lentic-configuration))
  "Returns this-buffer for this configuration object.
In most cases, this is likely to be the `current-buffer' but
this should not be relied on."
  (oref conf this-buffer))

(cl-defmethod lentic-that ((conf lentic-configuration))
  "Returns the that-buffer for this configuration object.
This may return nil if there is not that-buffer, probably because
it has not been created."
  (and (slot-boundp conf 'that-buffer)
       (oref conf that-buffer)))

(cl-defmethod lentic-ensure-that ((conf lentic-configuration))
  "Get the lentic for this configuration
or create it if it does not exist."
  (or (lentic-that conf)
      (lentic-create conf)))

This part of the user interface is not ideal at the moment. I need something which allows me to see all the currently active lentic-buffers, but I am far from convinced that the mode-line is the best place, since the mode-line gets overly full for most users.

As a second problem, supporting mode-line display directly in the configuration object seems right, and breaks the encapsulation between lentic.el and lentic-mode.el. Probably this needs to be replaced by some sort of status keyword return value.

(cl-defmethod lentic-mode-line-string ((conf lentic-configuration))
  "Returns a mode-line string for this configuration object."
  (when (slot-boundp conf 'that-buffer)
    (let ((that (oref conf that-buffer)))
      (if
          (and that
               (buffer-live-p that))
          "on"
        ""))))

Next: , Previous: , Up: Code   [Contents]

3.6.3 Default Configuration

This is the default implementation of a lentic configuration. It provides an identity transformation at that string level – the two buffers will (should!) have identical ‘buffer-string’ at all times. Or, more strictly, identical without properties, so identical (buffer-substring-no-properties (point-min) (point-max)), which is not nearly so snappy.

We add two more properties to this class – perhaps these should be pushed upwards.

(defclass lentic-default-configuration (lentic-configuration)
  ((lentic-file
    :initform nil
    :initarg :lentic-file
    :documentation
    "The name of the file that will be associated with that lentic buffer.")
   (lentic-mode
    :initform nil
    :initarg :lentic-mode ;; FIXME: Not used.
    :documentation
    "The mode for that lentic buffer."))
  "Configuration which maintains two lentics with the same contents.")

We add in a string transformation function here. There has no actual function within lentic per se, but it is used in lentic-dev as something we can advice. This avoids bulking up the code in lentic, while still allows me to affect the transformation during development of new transforms.

(defun lentic-insertion-string-transform (string)
  "Transform the STRING that is about to be inserted.
This function is not meant to do anything. It's useful to
advice."
  string)

The default methods should be self-explanatory!

(cl-defmethod lentic-create ((conf lentic-default-configuration))
  "Create an new lentic buffer. This creates the new buffer sets
the mode to the same as the main buffer or which ever is
specified in the configuration. The current contents of the main
buffer are copied."
  ;; make sure the world is ready for lentic buffers
  (lentic-ensure-hooks)
  ;; create lentic
  (let* ((this-buffer
          (lentic-this conf))
         (that-buffer
          (generate-new-buffer
           (format "*lentic: %s*"
                   (buffer-name
                    this-buffer))))
         (sec-file (oref conf lentic-file))
         (sec-mode
          (or
           ;; the specified normal mode
           (oref conf lentic-mode)
           ;; if we have a file try normal mode
           (if sec-file
               'normal-mode
             ;; otherwise the same mode as the main file
             major-mode))))
    (oset conf creator t)
    ;; make sure this-buffer knows about that-buffer
    (oset conf that-buffer that-buffer)
    ;; init that-buffer with mode, file and config
    ;; the mode must be init'd after adding content in case there are any
    ;; file-local variables need to be evaled
    ;; insert the contents
    (lentic-update-contents conf)
    (with-current-buffer that-buffer
      (when sec-mode
        (funcall sec-mode))
      (when sec-file
        (set-visited-file-name sec-file))
      (setq lentic-config
            (list (lentic-invert conf))))
    that-buffer))

(defun lentic--file-equal-p (f1 f2)
  (let ((a1 (file-attributes f1))
        (a2 (file-attributes f2)))
    (and a1 (equal a1 a2))))

(cl-defmethod lentic-coexist? ((this-conf lentic-default-configuration)
                            that-conf)
  "By default, we can have multiple lentic buffers with the same
configuration, unless specifically disallowed, or unless it has
the same associated file as pre-existing buffer (which is going
to break!)."
  (and
   (not (oref this-conf singleton))
   (not
    (and (oref this-conf lentic-file)
         (oref that-conf lentic-file)
         (lentic--file-equal-p
          (oref this-conf lentic-file)
          (oref that-conf lentic-file))))))

(cl-defmethod lentic-invert ((conf lentic-default-configuration))
  "By default, return a clone of the existing object, but switch
the this and that buffers around. "
  (clone
   conf
   :this-buffer (lentic-that conf)
   :that-buffer (lentic-this conf)
   :sync-point (oref conf sync-point)))

(cl-defmethod lentic-convert ((_conf lentic-default-configuration)
                           location)
  "The two buffers should be identical, so we just return the
  same location."
  location)

(cl-defmethod lentic-clone ((conf lentic-configuration)
                                &optional start stop _length-before
                                start-converted stop-converted)
  "The default clone method cuts out the before region and pastes
in the new."
  (let ((this-b (lentic-this conf))
        (that-b (lentic-that conf)))
    (with-current-buffer this-b
      ;;(lentic-log "this-b (point,start,stop)(%s,%s,%s)" (point) start stop)
      (save-window-excursion
        (save-restriction
          (widen)
          (let* ((start (or start (point-min)))
                 (stop (or stop (point-max))))
            (with-current-buffer that-b
              (save-restriction
                (widen)
                ;; get the start location that we converted before the change.
                ;; lentic-convert is not reliable now, because the two
                ;; buffers do not share state until we have percolated it
                (let ((converted-start
                       (max (point-min)
                            (or start-converted
                                (point-min))))
                      (converted-stop
                       (min (point-max)
                            (or stop-converted
                                (point-max)))))
                  (delete-region converted-start
                                 converted-stop)
                  (save-excursion
                    (goto-char converted-start)
                    ;; so this insertion is happening at the wrong place in block
                    ;; comment -- in fact, it's happening one too early
                    (insert
                     (with-current-buffer this-b
                       ;; want to see where it goes
                       ;; hence the property
                       (lentic-insertion-string-transform
                        (buffer-substring-no-properties
                         start stop))))
                    (list converted-start
                          (+ converted-start (- stop start))
                          (- converted-stop converted-start))))))))))))

;;;###autoload
(defun lentic-default-init ()
  "Default init function.
see `lentic-init' for details."
  (lentic-default-configuration
   :this-buffer (current-buffer)))

(add-to-list 'lentic-init-functions #'lentic-default-init)


Next: , Previous: , Up: Code   [Contents]

3.6.4 Basic Operation

In this section, we define some utility functions and the hooks we need into the core Emacs operations.

  1. Utility

    We start with some utility macros. These deal with the fact that a buffer can have a lentic or not, and that even if it does that lentic does not need to be live. This happens for instance if a lentic buffer is deleted – the buffer object will still be live (because the configuration object hangs on to it).

    At some point, the hook system needs to clean this up by detecting the buffer-kill and removing the configuration objection.

    (defmacro lentic-when-lentic (&rest body)
      "Evaluate BODY when the `current-buffer' has a lentic buffer."
      (declare (debug t))
      `(when (and
              lentic-config
              (-any?
               (lambda (conf)
                 (-when-let
                     (buf (lentic-that conf))
                   (buffer-live-p buf)))
               lentic-config))
         ,@body))
    
    (defmacro lentic-when-buffer (buffer &rest body)
      "When BUFFER is a live buffer eval BODY."
      (declare (debug t)
               (indent 1))
      `(when (buffer-live-p ,buffer)
         ,@body))
    
    (defmacro lentic-when-with-current-buffer (buffer &rest body)
      "When BUFFER is a live buffer eval BODY with BUFFER current."
      (declare (debug t)
               (indent 1))
      `(lentic-when-buffer ,buffer
         (with-current-buffer ,buffer
           ,@body)))
    
    (defmacro lentic-with-lentic-buffer (buffer &rest body)
      "With BUFFER as current, eval BODY when BUFFER has a lentic."
      (declare (debug t)
               (indent 1))
      `(lentic-when-with-current-buffer ,buffer
         (when lentic-config
           ,@body)))
    
    
    (defvar lentic-condition-case-disabled
      noninteractive
      "If non-nil throw exceptions from errors.
    
    By default this is set to the value of noninteractive, so that
    Emacs crashes with backtraces in batch." )
    
    (defmacro lentic-condition-case-unless-disabled (var bodyform &rest handlers)
      "Like `condition-case' but can be disabled like `condition-case-unless-debug'."
      (declare (debug condition-case) (indent 2))
      `(if lentic-condition-case-disabled
           ,bodyform
         (condition-case-unless-debug ,var
             ,bodyform
           ,@handlers)))
    
    (defmacro lentic-widen (conf &rest body)
      "Widen both buffers in CONF, then evaluate BODY."
      (declare (debug t)
               (indent 1))
      `(with-current-buffer
           (lentic-that ,conf)
         (save-restriction
           (widen)
           (with-current-buffer
               (lentic-this ,conf)
             (save-restriction
               (widen)
               ,@body)))))
    

    Recurse down the lentic tree to all lentic views.

    (defun lentic-each (buffer fn &optional seen-buffer)
      "Starting at BUFFER, call FN on every lentic-buffer.
    FN should take a single argument which is the buffer.
    SEEN-BUFFER is a list of buffers to ignore."
      (lentic-with-lentic-buffer buffer
        (setq seen-buffer (cons buffer seen-buffer))
        (-map
         (lambda (conf)
           (let ((that
                  (lentic-that conf)))
             (when (and (not (-contains? seen-buffer that))
                      (buffer-live-p that))
               (funcall fn that)
               (lentic-each that fn seen-buffer))))
         lentic-config)))
    
    (defun lentic-garbage-collect-config ()
      "Remove non-live configs in current-buffer."
      (setq lentic-config
            (--filter
             (buffer-live-p
              (lentic-that it))
             lentic-config)))
    
  2. Initialisation
    (defun lentic-ensure-init ()
      "Ensure that the `lentic-init' has been run."
      (lentic-garbage-collect-config)
      (setq lentic-config
            ;; and attach to lentic-config
            (-concat
             lentic-config
             ;; return only those that can co-exist
             (-filter
              (lambda (this-conf)
                (-all?
                 (lambda (that-conf)
                   (lentic-coexist? this-conf that-conf))
                 lentic-config))
              (-map
               (lambda (init)
                 ;; instantiate a new conf object (but do not create the buffer)
                 (funcall init))
               (if (not lentic-init)
                   '(lentic-default-init)
                 (-list lentic-init)))))))
    
    (defun lentic-init-all-create ()
      "Create all lentics fo the current buffer."
      (lentic-ensure-init)
      (-map
       (lambda (conf)
         (if (and
              (slot-boundp conf 'that-buffer)
              (buffer-live-p
               (lentic-that conf)))
             (lentic-that conf)
           (lentic-create conf)))
       (-list lentic-config)))
    
  3. Hook System

    The lentic hook system is relatively involved, unfortunately, and will probably become more so. In so far as possible, though, all of the complexity should be here, using the methods provided in the lentic-configuration object.

    The complexity of the hook system and the fact that it is hooked deeply into the core of Emacs can make it quite hard to debug. There are a number of features put in place to help deal with this. These are:

    • A logging system
    • An emergency detection system.
    • Two part hooks

    Start by enabling hooks!

    (defun lentic-ensure-hooks ()
      "Ensures that the hooks that this mode requires are in place."
      (add-hook 'post-command-hook
                #'lentic-post-command-hook)
      ;; FIXME: Do we really need these hook functions to affect *all* buffers?
      (add-hook 'after-change-functions
                #'lentic-after-change-function)
      (add-hook 'before-change-functions
                #'lentic-before-change-function)
      (add-hook 'after-save-hook
                #'lentic-after-save-hook)
      (add-hook 'kill-buffer-hook
                #'lentic-kill-buffer-hook)
      (add-hook 'kill-emacs-hook
                #'lentic-kill-emacs-hook))
    
    

    The logging system which allows post-mortem analysis of what lentic has done. Originally, my plan was to leave logging in place so aid analysis of bug reports, but this requires so much logging that it the log buffer becomes impossible to analyse.

    (defvar lentic-log nil)
    (defmacro lentic-log (&rest rest)
      "Log REST."
      `(when lentic-log
         (lentic-when-lentic
          (let ((msg
                 (concat
                  (format ,@rest)
                  "\n")))
            (princ msg #'external-debugging-output)))))
    

    An emergency detection system. Several of the hooks in use (post-command-hook, and the before- and after-change-functions) automatically remove hook functions which give errors. In development, this means that all errors are silently ignored and, worse, lentic continues in an inconsistent state with some hooks working and some not. Lentic catches all errors, therefore, and then drops into an "lentic-emergency" state, where all lentic functionality is disabled. This is still a dangerous state as changes do not percolate, but at least it should be predictable. The emergency state can be changed with ‘lentic-unemergency’ and ‘lentic-emergency’.

    
    (defvar lentic-emergency  nil
      "Iff non-nil halt all lentic activity.
    
    This is not the same as disabling lentic mode. It stops all
    lentic related activity in all buffers; this happens as a result
    of an error condition. If lentic was to carry on in these
    circumstances, serious data loss could occur. In normal use, this
    variable will only be set as a result of a problem with the code;
    it is not recoverable from a user perspective.
    
    It is useful to toggle this state on during development. Once
    enabled, buffers will not update automaticaly but only when
    explicitly told to. This is much easier than try to debug errors
    happening on the after-change-hooks. The
    function `lentic-emergency' and `lentic-unemergency' functions
    enable this.")
    
    (defvar lentic-emergency-debug nil
      "Iff non-nil, lentic will store change data, even
    during a `lentic-emergency'.
    
    Normally, `lentic-emergency' disables all activity, but this makes
    testing incremental changes charge. With this variable set, lentic will
    attempt to store enough change data to operate manually. This does require
    running some lentic code (notably `lentic-convert'). This is low
    risk code, but may still be buggy, and so setting this variable can cause
    repeated errors.")
    
    (defun lentic-emergency ()
      "Stop lentic from working due to code problem."
      (interactive)
      (setq lentic-emergency t)
      (lentic-update-all-display))
    
    (defun lentic-unemergency ()
      "Start lentic working after stop due to code problem."
      (interactive)
      (setq lentic-emergency nil)
      (lentic-update-all-display))
    
    (defun lentic-hook-fail (err hook)
      "Give an informative message when we have to fail.
    ERR is the error. HOOK is the hook type."
      (message "lentic mode has failed on \"%s\" hook: %s "
               hook (error-message-string err))
      (lentic-emergency)
      (with-output-to-temp-buffer "*lentic-fail*"
        (princ "There has been an error in lentic-mode.\n")
        (princ "The following is debugging information\n\n")
        (princ (format "Hook: %s\n" hook))
        (princ (error-message-string err)))
      (select-window (get-buffer-window "*lentic-fail*")))
    

    As a byproduct of the last, lentic also has two part hooks: the real hook function which just handles errors and calls the second function which does the work. This make it possible to call the second function interactively, without catching errors (so that they can be debugged) or causing the lentic-emergency state. There are some utility functions in lentic-dev for running hooks which require arguments.

    1. General Hook

      Start by handling saving, killing and general connecting with the Emacs behaviour.

      (defun lentic-after-save-hook ()
        "Error protected call to real after save hook."
        (unless lentic-emergency
          (lentic-condition-case-unless-disabled err
              (lentic-after-save-hook-1)
            (error
             (lentic-hook-fail err "after-save-hook")))))
      
      (defun lentic-after-save-hook-1 ()
        "Respond to a save in the `current-buffer'.
      This also saves every lentic which is file-associated."
        (lentic-each
         (current-buffer)
         (lambda (buffer)
           (with-current-buffer
               buffer
             (when (buffer-file-name)
               (save-buffer))))))
      
      (defvar lentic-kill-retain nil
        "If non-nil retain files even if requested to delete on exit.")
      
      (defun lentic-kill-buffer-hook ()
        "Error protected call to real `kill-buffer-hook'."
        (unless lentic-emergency
          (lentic-condition-case-unless-disabled err
              (lentic-kill-buffer-hook-1)
            (error
             (lentic-hook-fail err "kill-buffer-hook")))))
      
      (defvar lentic--killing-p nil)
      
      (defun lentic-kill-buffer-hook-1 ()
        "Respond to any buffer being killed.
      If this killed buffer is lentic and is `creator', then kill all
      lentic-buffers recursively. If the buffer is `delete-on-exit',
      then remove any associated file."
        (lentic-when-lentic
         (when
             (and
              (--any?
               (oref it delete-on-exit)
               lentic-config)
              ;; might not exist if we not saved yet!
              (file-exists-p buffer-file-name)
              ;; if we are cloning in batch, we really do not want to kill
              ;; everything at the end
              (not noninteractive)
              ;; or we have blocked this anyway
              (not lentic-kill-retain))
           (delete-file buffer-file-name))
         ;; if we were the creator buffer, blitz the lentics (which causes their
         ;; files to delete also).
         ;; FIXME: "-p" is for *p*redicates, not boolean values.
         (defvar lentic-killing-p)
         (let ((lentic-killing-p t))
           (when
               (and
                (not lentic-killing-p)
                (--any?
                 (oref it creator)
                 lentic-config))
             (lentic-each
              (current-buffer)
              #'kill-buffer)))))
      
      (defun lentic-kill-emacs-hook ()
        "Error protected call to real `kill-emacs-hook'."
        (unless lentic-emergency
          (lentic-condition-case-unless-disabled err
              (lentic-kill-emacs-hook-1)
            (error
             (lentic-hook-fail err "kill-emacs-hook")))))
      
      (defun lentic-kill-emacs-hook-1 ()
        "Respond to `kill-emacs-hook.
      This removes any files associated with lentics which are
      marked as :delete-on-exit."
        (-map
         (lambda (buffer)
           (lentic-with-lentic-buffer
               buffer
             (-map
              (lambda (conf)
                (and
                 (oref conf delete-on-exit)
                 (file-exists-p buffer-file-name)
                 (not noninteractive)
                 (delete-file (buffer-file-name))))
              lentic-config)))
         (buffer-list)))
      
    2. Change Hooks

      Handling and percolating changes is the most complex part of lentic, made more complex still by the decision to support multiple buffers (why did I do that to myself?).

      The ‘post-command-hook’ just percolates location of point through all the lentic buffers.

      (defun lentic-post-command-hook ()
        "Update point according to config, with error handling."
        (unless lentic-emergency
          (lentic-condition-case-unless-disabled err
              (progn
                ;; we test for this later anyway, but this makes it easier to debug.
                (when lentic-config
                  (lentic-post-command-hook-1 (current-buffer))))
            (error
             (lentic-hook-fail err "post-command-hook")))))
      
      (defun lentic-post-command-hook-1 (buffer &optional seen-buffer)
        "Update point in BUFFER according to config.
      SEEN-BUFFER is a list of lentics that have already been updated."
        (lentic-with-lentic-buffer
            buffer
          ;; now we have seen this buffer don't look again
          (setq seen-buffer (cons buffer seen-buffer))
          ;; for all configurations
          (-map
           (lambda (config)
             (let ((that
                    (lentic-that config)))
               ;; check for the termination condition
               (unless (-contains? seen-buffer that)
                 (lentic-when-buffer
                     that
                   ;; then update and recurse
                   (lentic-update-point config))
                 (lentic-post-command-hook-1 (lentic-that config) seen-buffer))))
           lentic-config)))
      

      The ‘after-change-function’ is by far the most complex of the hooks. This is because we have to percolate the changes from the buffer that has changed as a result of the user doing something to all the other buffers. In theory, this should be straight-forward: combined with the ‘before-change-function’, the data from the ‘after-change-function’ defines a "dirty region" which we need to update by copying from the parent and then doing what ever transformation needs to happen. The problem is that that the contract from the configuration objects’ ‘lentic-clone’ method is that at least the dirty region will be replaced. ‘lentic-clone’ can actually replace much more than this, and often needs to do so, to ensure a consistent transformation.

      So, when a lentic-buffer updates it needs to update it’s own dirty region but also return the dirty region that it has created, so that any lentic buffers that it in turn has that are still to be updated can be so. Or, if it doesn’t, we just assume the whole buffer is dirty which is safe but inefficient.

      The main after-change-function also stores the its arguments if we are in debug mode which allows me to run ‘lentic-after-change-function-1’ interactively with the correct arguments.

      (defvar lentic-emergency-last-change nil)
      (make-variable-buffer-local 'lentic-emergency-last-change)
      
      (defun lentic-after-change-transform (_buffer _start _stop _length-before)
        "Function called after every change percolated by lentic.
      This function does nothing and is meant for advising. See
      lentic-dev."
      )
      
      (defun lentic-after-change-function (start stop length-before)
        "Run change update according to `lentic-config'.
      Errors are handled.
      START is at most the start of the change.
      STOP is at least the end of the change.
      LENGTH-BEFORE is the length of the area before the change."
        ;; store values in case we want to use them
        (when lentic-emergency-debug
          (setq lentic-emergency-last-change (list start stop length-before)))
        (unless lentic-emergency
          (lentic-condition-case-unless-disabled err
              (lentic-after-change-function-1
               (current-buffer) start stop length-before)
            (error
             (lentic-hook-fail err "after change")))))
      
      (defun lentic-after-change-function-1
          (buffer start stop
                  length-before &optional seen-buffer)
        "Run change update according to `lentic-config'.
      BUFFER is the changed buffer.
      START is at most the start of the change.
      STOP is at least the end of the change.
      LENGTH-BEFORE is the length of the area before the change.
      SEEN-BUFFER is a list of buffers to which we have already percolated
      the change."
        (lentic-with-lentic-buffer buffer
          (setq seen-buffer (cons buffer seen-buffer))
          (-map
           (lambda (config)
             (unless
                 (or (-contains? seen-buffer (lentic-that config))
                     (not (buffer-live-p (lentic-that config))))
               (let ((updates
                      (or
                       (lentic-update-contents config
                                               start stop length-before)
                       '(nil nil nil))))
                 (apply #'lentic-after-change-transform
                        (lentic-that config)
                        updates)
                 (lentic-after-change-function-1
                  (lentic-that config)
                  (nth 0 updates)
                  (nth 1 updates)
                  (nth 2 updates)
                  seen-buffer))))
           lentic-config)))
      

      We also need to store the location of the area to be changed before the change happens. Further, we need to convert this at this time to the cognate positions in the lentic buffers. This is because it is only before the change that this-buffer and the lentic buffers are in a consistent state; after the change, this-buffer will have changes not percolated to other buffers. By making this conversion now, we can ease the implementation of the ‘lentic-convert’ function because it does not have to cope with buffers with inconsistent content.

      (defun lentic-before-change-function (start stop)
        "Error protected call to real `before-change-function'.
      START is at most the start of the change.
      STOP is at least the end of the change."
        (unless (and
                 lentic-emergency
                 (not lentic-emergency-debug))
          (lentic-condition-case-unless-disabled err
              (lentic-before-change-function-1 (current-buffer) start stop)
            (error
             (lentic-hook-fail err "before change")))))
      
      (defun lentic-before-change-function-1 (buffer start stop &optional seen-buffer)
        "Calculate change position in all lentic buffers.
      BUFFER is the buffer being changed.
      START is at most the start of the change.
      STOP is at least the end of the change.
      SEEN-BUFFER is a list of buffers to which the change has been percolated."
        (lentic-with-lentic-buffer buffer
          (setq seen-buffer (cons buffer seen-buffer))
          (-map
           (lambda (config)
             (unless
                 (or (-contains? seen-buffer (lentic-that config))
                     ;; convert uses that buffer
                     (not (buffer-live-p (lentic-that config))))
               (lentic-widen
                   config
                 (oset config last-change-start start)
                 (oset config
                       last-change-start-converted
                       (lentic-convert
                        config
                        start))
                 (oset config last-change-stop stop)
                 (oset config
                       last-change-stop-converted
                       (lentic-convert
                        config
                        stop))
                 (lentic-before-change-function-1
                  (lentic-that config)
                  (oref config last-change-start-converted)
                  (oref config last-change-stop-converted)
                  seen-buffer))))
           lentic-config)))
      

      The ‘lentic-update-contents’ actually transfers changes from one buffer to all the lentics. Unfortunately before-change-function and after-change-function are not always consistent with each other. So far the main culprit I have found is ‘subst-char-in-region’, which is used under the hood of ‘fill-paragraph’. On the b-c-f this reports the real start of the change and the maximal end, while on the a-c-f it reports both the real start and real end. Unfortunately, we did our conversion to the cognate positions in the b-c-f and we need these values.

      The overestimate give inconsistency between the length before on a-c-f (which is the actual length) and the difference between b-c-f start and stop (which is the maximal change). Unfortunately, this can also occur in some correct circumstances – replace-match for example can both insert and change simultaneously.

      So, the only solution that I have is to use a heuristic to detect skew – when I think the b-c-f and a-c-f are inconsistent, and if it finds it, then use a full clone (i.e. the whole buffer is dirty).

      I need to do a full survey of all the functions that call b-c-f/a-c-f (there are not that many of them!) and rewrite them to all do-the-right thing. Need to learn C first!

      (defun lentic-update-contents (conf &optional start stop length-before)
        "Update the contents of that-buffer with the contents of this-buffer.
      update mechanism depends on CONF.
      START is at most the start of the change.
      STOP is at least the end of the change.
      LENGTH-BEFORE is the length of area before the change."
        (let ((inhibit-read-only t)
              (no-fall-back
               (and start stop length-before)))
          (when
              (and no-fall-back
                   (< (+ start length-before) (oref conf last-change-stop)))
            (let ((diff
                   (- (oref conf last-change-stop)
                      (+ start length-before))))
              (lentic-log "Skew detected %s" this-command)
              (cl-incf length-before diff)
              (cl-incf stop diff)))
          (m-buffer-with-markers
              ((start-converted
                (when
                    (and no-fall-back
                         (oref conf last-change-start-converted))
                  (set-marker (make-marker)
                              (oref conf last-change-start-converted)
                              (lentic-that conf))))
               (stop-converted
                (when
                    (and no-fall-back
                         (oref conf last-change-stop-converted))
                  (set-marker (make-marker)
                              (oref conf last-change-stop-converted)
                              (lentic-that conf)))))
            ;; used these, so dump them
            (oset conf last-change-start nil)
            (oset conf last-change-start-converted nil)
            (oset conf last-change-stop nil)
            (oset conf last-change-stop-converted nil)
            (lentic-widen
                conf
              (if (not no-fall-back)
                  (lentic-clone conf)
                (lentic-clone conf start stop length-before
                              start-converted stop-converted))))))
      
      (defun lentic-update-point (conf)
        "Update the location of point in that-buffer to reflect this-buffer.
      This also attempts to update any windows so that they show the
      same top-left location. Update details depend on CONF."
        ;; only sync when we are told to!
        (when (oref conf sync-point)
          (let* ((from-point
                  (lentic-convert
                   conf
                   (m-buffer-at-point
                    (lentic-this conf))))
                 (from-window-start
                  (lentic-convert
                   conf
                   (window-start
                    (get-buffer-window
                     (lentic-this conf))))))
            ;; clone point in buffer important when the buffer is NOT visible in a
            ;; window at all
            ;;(lentic-log "sync(front-point)(%s)" from-point)
            (with-current-buffer
                (lentic-that conf)
              (goto-char from-point))
            ;; now clone point in all the windows that are showing the buffer
            ;; and set the start of the window which is a reasonable attempt to show
            ;; the same thing.
            (mapc
             (lambda (window)
               (with-selected-window window
                 (progn
                   (goto-char from-point)
                   (set-window-start window from-window-start))))
             (get-buffer-window-list (lentic-that conf))))))
      
      

      Ugly, ugly, ugly. Not happy with mode-line behaviour anyway, so this will probably change into the future.

      ;; put this here so we don't have to require lentic-mode to ensure that the
      ;; mode line is updated.
      (defun lentic-update-display ()
        "Update the display with information about lentic's state."
        (when (fboundp 'lentic-mode-update-mode-line)
          (lentic-mode-update-mode-line)))
      
      (defun lentic-update-all-display ()
        (when (fboundp 'lentic-mode-update-all-display)
          (lentic-mode-update-all-display)))
      
  4. Utility

    Just a couple of convenience functions for operating on eieio objects. The native ‘oset’ only allows setting a single property-value pair which is irritating syntactically, and it does not return the object which prevents function chaining. Taken together, these really simplify construction of objects.

    (defun lentic-m-oset (obj &rest plist)
      "On OBJ set all properties in PLIST.
    Returns OBJ. See also `lentic-a-oset'"
      (lentic-a-oset obj plist))
    
    (defun lentic-a-oset (obj plist)
      "On OBJ, set all properties in PLIST.
    This is a utility function which just does the same as oset, but
    for lots of things at once. Returns OBJ."
      (dolist (n (-partition 2 plist))
        (eieio-oset obj (car n) (cadr n)))
      obj)
    

Previous: , Up: Code   [Contents]

3.6.5 Batch Functions

These functions are for batch operation on lentic buffers. Mostly, these are useful for writing tests, but they can be useful for generating the lentic form of a file during any automated pipeline.

(defun lentic-batch-clone-and-save-with-config (filename init)
  "Open FILENAME, set INIT function, then clone and save.

This function does potentially evil things if the file or the
lentic is open already."
  (let ((retn))
    (with-current-buffer
        (find-file-noselect filename)
      (setq lentic-init init)
      (with-current-buffer
          (car
           (lentic-init-all-create))
        (setq retn lentic-config)
        (save-buffer)
        (kill-buffer))
      (kill-buffer))
    retn))

(defun lentic-batch-clone-with-config
  (filename init)
  "Open FILENAME, set INIT function, then clone.

Return the lentic contents without properties."
  (let ((retn nil))
    (with-current-buffer
        (find-file-noselect filename)
      (setq lentic-init init)
      (with-current-buffer
          (car
           (lentic-init-all-create))
        (setq retn
              (buffer-substring-no-properties
               (point-min)
               (point-max)))
        (set-buffer-modified-p nil)
        ;; don't delete -- we haven't saved but there
        ;; might already be a file with the same name,
        ;; which will get deleted
        (oset (car lentic-config) delete-on-exit nil)
        (kill-buffer))
      (set-buffer-modified-p nil)
      (kill-buffer))
    retn))

(provide 'lentic)

;;; lentic.el ends here

4 Lentic Mode

lentic-mode.el provides end-user functions for creating and manipulating lentic buffers.


Next: , Up: Lentic Mode   [Contents]

4.1 Header

This file is not part of Emacs

Author: Phillip Lord <[email protected]> Maintainer: Phillip Lord <[email protected]> The contents of this file are subject to the GPL License, Version 3.0.

Copyright (C) 2014-2024 Free Software Foundation, Inc.

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/.


Next: , Previous: , Up: Lentic Mode   [Contents]

4.2 Commentary

A minor mode for creating and manipulated lentic buffers.


Previous: , Up: Lentic Mode   [Contents]

4.3 Code


Next: , Up: Code   [Contents]

4.3.1 Preliminaries

(require 'lentic)
(require 'lentic-doc)

4.3.2 Utility

(defun lentic-mode-lentic-list (buffer)
  "Return a list of all lentics for BUFFER.
Lentics are listed in an undefined order."
  (lentic-mode--lentic-list-1 buffer nil))

(defun lentic-mode--lentic-list-1 (buffer _seen-buffer)
  (let ((buffers))
    (lentic-each
     buffer
     (lambda (b)
       (push b buffers)))
    buffers))

(defun lentic-mode-buffer-list (buffer &optional frame)
  "Returns a list of all lentics for BUFFER.
Lentics are listed in the same order as in fundamental
`buffer-list'. or the frame local if FRAME is specified."
  (let ((lentic-list
         (lentic-mode-lentic-list buffer)))
    (-filter
     (lambda (b)
       (-contains? lentic-list b))
     (buffer-list frame))))

(defun lentic-mode-find-next-lentic-buffer (buffer &optional frame)
  (car
   (--drop-while
    (eq buffer it)
    (lentic-mode-buffer-list
     buffer (or frame (selected-frame))))))

(defun lentic-mode-find-next-visible-lentic-buffer (buffer &optional frame)
  (car
   (--drop-while
    (or (eq buffer it)
        (not (get-buffer-window it frame)))
    (lentic-mode-buffer-list
     buffer (or frame (selected-frame))))))

(defun lentic-mode-find-next-non-visible-lentic-buffer (buffer &optional frame)
  (car
   (--drop-while
    (or (eq buffer it)
        (get-buffer-window it frame))
    (lentic-mode-buffer-list
     buffer (or frame (selected-frame))))))

Next: , Previous: , Up: Code   [Contents]

4.3.3 Window and Buffer Functions

(defun lentic-mode-show-buffer-in-window (before-buffer new-buffer)
  (let* ((buffer-window (get-buffer-window before-buffer))
         (before-window-start
          (window-start buffer-window))
         (before-window-point
          (m-buffer-at-point before-buffer)))
    (set-window-buffer
     buffer-window
     new-buffer)
    (set-window-start
     buffer-window
     before-window-start)
    (goto-char before-window-point)
    (bury-buffer before-buffer)))

;;;###autoload
(defun lentic-mode-create-from-init (&optional force)
  (interactive "P")
  (lentic-garbage-collect-config)
  (if (and lentic-config (not force))
      (message "Already initialized. C-u to force.")
    (let ((before (length lentic-config))
          (all (lentic-init-all-create)))
      (message "Created %s buffers"
               (- (length all)
                  before)))))


;;;###autoload
(defun lentic-mode-next-lentic-buffer ()
  "Move the lentic buffer into the current window, creating if necessary."
  (interactive)
  (lentic-mode-show-buffer-in-window
   (current-buffer)
   (lentic-mode-find-next-lentic-buffer (current-buffer))))

;;;###autoload
(defun lentic-mode-split-window-below ()
  "Move lentic buffer to the window below, creating if needed."
  (interactive)
  (-when-let
      (next
       (lentic-mode-find-next-non-visible-lentic-buffer
        (current-buffer)))
    (set-window-buffer
     (split-window-below)
     next)
    next))

;;;###autoload
(defun lentic-mode-split-window-right ()
  "Move lentic buffer to the window right, creating if needed."
  (interactive)
  (-when-let
      (next
       (lentic-mode-find-next-non-visible-lentic-buffer
        (current-buffer)))
    (set-window-buffer
     (split-window-right)
     next)
    next))

;;;###autoload
(defun lentic-mode-show-all-lentic ()
  (interactive)
  (delete-other-windows)
  (while
      (lentic-mode-split-window-below))
  (balance-windows))

(defun lentic-mode-swap-buffer-windows (a b)
  "Swaps the window that two buffers are displayed in.
A and B are the buffers."
  (let ((window-a (get-buffer-window a))
        (window-b (get-buffer-window b)))
    (when window-a
      (set-window-buffer
       window-a b))
    (when window-b
      (set-window-buffer
       window-b a))))

;;;###autoload
(defun lentic-mode-move-lentic-window ()
  "Move the next lentic buffer into the current window.
If the lentic is currently being displayed in another window,
then the current-buffer will be moved into that window. See also
`lentic-mode-swap-buffer-windows' and `lentic-mode-next-buffer'."
  (interactive)
  (let ((before-window-start
         (window-start (get-buffer-window)))
        (before-window-point
         (point)))
    (lentic-mode-swap-buffer-windows
     (current-buffer)
     (or
      (lentic-mode-find-next-visible-lentic-buffer
       (current-buffer))
      (lentic-mode-find-next-lentic-buffer
       (current-buffer))))
    (set-window-start
     (selected-window)
     before-window-start)
    (goto-char before-window-point)))

;;;###autoload
(defun lentic-mode-swap-lentic-window ()
  "Swap the window of the buffer and lentic.
If both are current displayed, swap the windows they
are displayed in, which keeping current buffer.
See also `lentic-mode-move-lentic-window'."
  (interactive)
  (let ((next
         (lentic-mode-find-next-visible-lentic-buffer
          (current-buffer))))
    (if (not next)
        (message "Cannot swap windows when only one is visible")
      (lentic-mode-swap-buffer-windows
       (current-buffer)
       next)
      (when (window-live-p
             (get-buffer-window
              (current-buffer)))
        (select-window
         (get-buffer-window
          (current-buffer)))))))

(defun lentic-mode-create-new-view ()
  (let* ((conf (lentic-default-init))
         (_ (oset conf
                  :sync-point nil))
         (that (lentic-create conf)))
    (setq lentic-config
          (cons conf lentic-config))
    that))

;;;###autoload
(defun lentic-mode-create-new-view-in-selected-window ()
  (interactive)
  (set-window-buffer
   (selected-window)
   (lentic-mode-create-new-view)))

(defun lentic-mode-force-clone-1 ()
  (lentic-when-lentic
   (let ((inhibit-modification-hooks t))
     (lentic-after-change-function
      (point-min) (point-max)
      (- (point-max) (point-min))))))

(defun lentic-mode-force-clone ()
  (interactive)
  (when (yes-or-no-p "Force Clone of the current buffer? ")
    (lentic-mode-force-clone-1)))

4.3.4 Minor Mode


;;;###autoload
(defun lentic-mode-toggle-auto-sync-point ()
  (interactive)
  (lentic-when-lentic
   (oset lentic-config sync-point
         (not (oref lentic-config sync-point)))))

(defvar lentic-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "C-c ,c") #'lentic-mode-create-from-init)
    (define-key map (kbd "C-c ,v")
                #'lentic-mode-create-new-view-in-selected-window)
    (define-key map (kbd "C-c ,n") #'lentic-mode-next-lentic-buffer)
    (define-key map (kbd "C-c ,s") #'lentic-mode-swap-lentic-window)
    (define-key map (kbd "C-c ,h") #'lentic-mode-move-lentic-window)
    (define-key map (kbd "C-c ,b") #'lentic-mode-split-window-below)
    (define-key map (kbd "C-c ,t") #'lentic-mode-split-window-right)
    (define-key map (kbd "C-c ,f") #'lentic-mode-insert-file-local)
    (define-key map (kbd "C-c ,a") #'lentic-mode-show-all-lentic)
    map)
  "Keymap for lentic-minor-mode")

(defcustom lentic-mode-line-lighter "Lentic"
  "Default mode lighter for lentic"
  :group 'lentic
  :type 'string)

(defvar-local lentic-mode-line (format " %s[]" lentic-mode-line-lighter))

(defun lentic-mode-update-mode-line ()
  (setq lentic-mode-line
        (format " %s[%s]"
                lentic-mode-line-lighter
                (mapconcat #'lentic-mode-line-string
                           lentic-config
                           ","))))

(defun lentic-mode-update-all-display ()
  (if lentic-emergency
      (setq lentic-mode-line
            (format " %s[Emergency]" lentic-mode-line-lighter))
    (dolist (b (buffer-list))
      (lentic-when-with-current-buffer b
        (lentic-mode-update-mode-line)))
    (force-mode-line-update t)))

;; ** lentic self-doc

;; #+begin_src: emacs-lisp
;;;###autoload
(defun lentic-mode-doc-eww-view ()
  (interactive)
  (lentic-doc-eww-view 'lentic))

;;;###autoload
(defun lentic-mode-doc-external-view ()
  (interactive)
  (lentic-doc-external-view 'lentic))

;;;###autoload
(define-minor-mode lentic-mode
  "Documentation"
  :lighter lentic-mode-line)

;; FIXME: Cannot autoload this before `lentic.el' is loaded since otherwise
;; we get (void-variable lentic-config) errors in redisplay.
;; ;;;###autoload
(easy-menu-change
 '("Edit")
 "Lentic"
 '(["Create All" lentic-mode-create-from-init
    :active (not lentic-config)]
   ["Create View" lentic-mode-create-new-view-in-selected-window]
   ["Next" lentic-mode-next-lentic-buffer
    :active lentic-config]
   ["Split Below" lentic-mode-split-window-below
    :active lentic-config]
   ["Split Right" lentic-mode-split-window-right
    :active lentic-config]
   ["Show All" lentic-mode-show-all-lentic
    :active lentic-config]
   ["Swap" lentic-mode-swap-lentic-window
    :active lentic-config]
   ["Force Clone" lentic-mode-force-clone
    :active lentic-config]
   ["Insert File Local" lentic-mode-insert-file-local]
   ["Read Doc (eww)" lentic-mode-doc-eww-view]
   ["Read Doc (external)" lentic-mode-doc-external-view]
   ))

;;;###autoload
(defun lentic-mode-insert-file-local (init-function)
  (interactive
   (list (completing-read
          "Lentic init function: "
          (mapcar
           #'symbol-name
           lentic-init-functions)
          nil 'confirm)))
  (add-file-local-variable 'lentic-init (intern init-function)))

;;;###autoload
(define-globalized-minor-mode global-lentic-mode
  lentic-mode
  lentic-mode-on)

(defun lentic-mode-on ()
  (lentic-mode 1))

(provide ’lentic-mode)

;;; lentic-mode.el ends here


5 Lentic Rot13

lentic-rot13.el is entirely useless for practical purposes but demonstrates how new lenticular transformations can be configured.


Next: , Up: Lentic Rot13   [Contents]

5.1 Header

This file is not part of Emacs

Author: Phillip Lord <[email protected]> Maintainer: Phillip Lord <[email protected]>

The contents of this file are subject to the GPL License, Version 3.0.

Copyright (C) 2015-2022 Free Software Foundation, Inc.

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/.


Next: , Previous: , Up: Lentic Rot13   [Contents]

5.2 Commentary

At some point in your life you may find yourself thinking, what would the text that I am writing now look like in rot13? Of course, you could just convert it, but really is to see the visualisation as you type. That would be useful!

Now you can.

Or more seriously, this is meant as a minimal example of how do implement a new lentic-buffer-configuration.


Previous: , Up: Lentic Rot13   [Contents]

5.3 Code

(require 'lentic)
(require 'rot13)

Lentic uses EIEIO objects to define the transformation between lentic buffers. In this case, we extend the default configuration class. We need to add nothing to the base class or constructor; all changes happen with the generic methods.

(defclass lentic-rot13-configuration (lentic-default-configuration) ())

The clone method defines how to keep the buffers in sync. We defer most of the work to the superclass method, and then simply rot13 the region that has changed.

The semantics of the parameters are a little complex. The ‘start’ and ‘stop’ parameters define the region in ‘this’ buffer that has been changed, while ‘start-converted’ and ‘stop-converted’ define the equivalent region before the change in ‘that’ buffer.

In this example, we are making implicit use of the fact that we can convert directly between a location in the two buffers. In future versions of ‘lentic-clone’ will probably return the changed region directly.

(cl-defmethod lentic-clone ((conf lentic-rot13-configuration)
                            &optional start stop &rest _)
  (cl-call-next-method)
  ;; and rot13 it!
  (with-current-buffer
      (lentic-that conf)
    (save-restriction
      (rot13-region
       (or start (point-min))
       (or stop (point-max))))))

Lentic buffers have a bi-directional link between them. So, while this buffer may create that buffer, after the initial creation, the two are equivalent lenticular views of each other. In terms of lentic, therefore, at creation time, we need to be able to invert the configuration of this buffer to create a configuration for that buffer which defines the transformation from that to this.

In this case, the rot13 transformation is symmetrical, so the conversion from that to this uses an object of the same class as from this to that.

(cl-defmethod lentic-invert ((conf lentic-rot13-configuration))
  (lentic-rot13-configuration
   :this-buffer (lentic-that conf)
   :that-buffer (lentic-this conf)))

And, finally, we need to create a function which will construct a new object. This has to be no-args because it is added as a symbol to ‘lentic-config’. It is this function which creates the configuration for initial buffer.

(defun lentic-rot13-init ()
  (lentic-rot13-configuration
   :this-buffer (current-buffer)))

(provide 'lentic-rot13)
;;; lentic-rot13.el ends here

6 Lentic Chunk

Lentic Block provides configurations where blocks of the buffer are commented in one buffer and not in the others. There are quite a few extensions of this configuration, including the one that is used to document this file.


Next: , Up: Lentic Chunk   [Contents]

6.1 Header

This file is not part of Emacs

Author: Phillip Lord <[email protected]> Maintainer: Phillip Lord <[email protected]>

The contents of this file are subject to the LGPL License, Version 3.0.

Copyright (C) 2014-2022 Free Software Foundation, Inc.

This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser 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 Lesser General Public License for more details.

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


Next: , Previous: , Up: Lentic Chunk   [Contents]

6.2 Commentary

Lentic-chunk provides support for editing lentic buffers where there are large documentation chunks in one view which must be commented out in the other, where the chunks are demarked with some kind of delimitor.

This form is generally useful for forms of literate programming. For example, we might embed Emacs-Lisp within LaTeX like so:

\begin{code}
(message "hello")
\end{code}

In this case, the ‘\begin{code}’ macro defines the start of the code chunk. In the code-centric view any lines not enclosed by the markers will be commented-out, ensure that the documentation does not interfere with whatever programming language is being used.

The implementation provided here is reasonably efficient, with only small change regions being percolated.

This package does not provide any direct end-user configurations. These are provided elsewhere.


Previous: , Up: Lentic Chunk   [Contents]

6.3 Code

The implementation


6.3.1 Chunk Configuration

(require 'm-buffer)
(require 'm-buffer-at)
(require 'lentic)

(defclass lentic-chunk-configuration (lentic-default-configuration)
  ((comment :initarg :comment
            :documentation "The comment character")
   (comment-start :initarg :comment-start
                  :documentation
                  "Demarcation for the start of the commenting region")
   (comment-stop :initarg :comment-stop
                 :documentation
                "Demarcaction for the end of the commenting region.")
   (case-fold-search :initarg :case-fold-search
                     :documentation
                     "Should match be case sensitive"
                     :initform :default)
   (valid :initarg :valid
          :documentation "True if markers in the buffer are valid"
          :initform t))
  :documentation "Base configuration for chunked lentics.
A chunked lentic is one where chunks of the buffer have a
start of line chunk comment in one buffer but not the other."
  :abstract t)

(cl-defmethod lentic-mode-line-string ((conf lentic-chunk-configuration))
  (if (not
       (oref conf valid))
      "invalid"
    (cl-call-next-method conf)))

(cl-defmethod lentic-chunk-comment-start-regexp
  ((conf lentic-chunk-configuration))
  ;; todo -- what does this regexp do?
  (format "^\\(%s\\)?%s"
          (oref conf comment)
          (oref conf comment-start)))

(cl-defmethod lentic-chunk-comment-stop-regexp
  ((conf lentic-chunk-configuration))
  (format "^\\(%s\\)?%s"
          (oref conf comment)
          (oref conf comment-stop)))

(cl-defmethod lentic-chunk-line-start-comment
  ((conf lentic-chunk-configuration))
  (concat "^"
          (oref conf comment)))

(defun lentic-chunk-uncomment-region (conf begin end buffer)
  "Given CONF,  remove start-of-line characters in region.
Region is between BEGIN and END in BUFFER. CONF is a
function `lentic-configuration' object."
  ;;(lentic-log "uncomment-region (%s,%s)" begin end)
  (m-buffer-with-markers
      ((comments
        (m-buffer-match
         buffer
         (lentic-chunk-line-start-comment conf)
         :begin begin :end end)))
    (m-buffer-replace-match comments "")))

(defun lentic-chunk-uncomment-buffer (conf markers begin end buffer)
  "Given CONF, a `lentic-configuration' object, remove all
start of line comment-characters in appropriate chunks. Changes
should only have occurred between BEGIN and END in BUFFER."
  (-map
   (lambda (pairs)
     (let
         ((chunk-begin (car pairs))
          (chunk-end (cadr pairs)))
       (when
           (and (>= end chunk-begin)
                (>= chunk-end begin))
         (lentic-chunk-uncomment-region
          conf chunk-begin chunk-end buffer))))
   markers))

(defun lentic-chunk-comment-region (conf begin end buffer)
  "Given CONF, a `lentic-configuration' object, add
start of line comment characters beween BEGIN and END in BUFFER."
  (m-buffer-with-markers
      ((line-match
        (m-buffer-match
         buffer
         "\\(^\\).+$"
         :begin begin :end end))
       (comment-match
        (m-buffer-match
         buffer
         ;; start to end of line which is what this regexp above matches
         (concat
          (lentic-chunk-line-start-comment conf)
          ".*")
         :begin begin :end end)))
    (m-buffer-replace-match
     (m-buffer-match-exact-subtract line-match comment-match)
     (oref conf comment) nil nil 1)))

(defun lentic-chunk-comment-buffer (conf markers begin end buffer)
  "Given CONF, a `lentic-configuration' object, add
start of line comment-characters. Changes should only have occurred
between BEGIN and END in BUFFER."
  ;; we need these as markers because the begin and end position need to
  ;; move as we change the buffer, in the same way that the marker boundary
  ;; markers do.
  (m-buffer-with-markers
      ((begin (set-marker (make-marker) begin buffer))
       (end (set-marker (make-marker) end buffer)))
    (-map
     ;; comment each of these regions
     (lambda (pairs)
       (let
           ((chunk-begin (car pairs))
            (chunk-end (cadr pairs)))
         (when
             (and (>= end chunk-begin)
                  (>= chunk-end begin))
           (lentic-chunk-comment-region
            conf chunk-begin chunk-end buffer))))
     markers)))

(cl-defmethod lentic-chunk-marker-boundaries ((conf lentic-chunk-configuration)
                                         buffer)
  "Given CONF, a `lentic-configuration' object, find
demarcation markers. Returns a list of start end cons pairs.
`point-min' is considered to be an implicit start and `point-max'
an implicit stop."
  (let* ((match-chunk
          (lentic-chunk-match
           conf buffer))
         (match-start
          (car match-chunk))
         (match-end
          (cadr match-chunk)))
    (if
        (= (length match-start)
           (length match-end))
        (progn
          (unless
              (oref conf valid)
            (oset conf valid t)
            (lentic-update-display))
          (with-current-buffer buffer
            (-zip-with
             #'list
             ;; start comment markers
             ;; plus the start of the region
             (cons
              (set-marker (make-marker) (point-min) buffer)
              match-start)
             ;; end comment markers
             ;; plus the end of the buffer
             (append
              match-end
              (list (set-marker (make-marker) (point-max) buffer))))))
      ;; delimiters do not match so return error value
      (lentic-log "delimiters do not match")
      (when (oref conf valid)
        (oset conf valid nil)
        (lentic-update-display))
      :unmatched)))

(cl-defmethod lentic-chunk-match ((conf lentic-chunk-configuration)
                                      buffer)
  (list
   (m-buffer-match-begin
    buffer
    (lentic-chunk-comment-start-regexp conf)
    :case-fold-search (oref conf case-fold-search))
   (m-buffer-match-end
    buffer
    (lentic-chunk-comment-stop-regexp conf)
    :case-fold-search (oref conf case-fold-search))))

(cl-defmethod lentic-convert ((conf lentic-chunk-configuration)
                                  location)
  "Converts a LOCATION in buffer FROM into one from TO.
This uses a simple algorithm; we pick the same line and then
count from the end, until we get to location, always staying on
the same line. This works since the buffers are identical except
for changes to the beginning of the line. It is also symmetrical
between the two buffers; we don't care which one has comments."
  ;; current information comes inside a with-current-buffer. so, we capture
  ;; data as a list rather than having two with-current-buffers.
  (let ((line-plus
         (with-current-buffer
             (lentic-this conf)
           (save-excursion
             ;; move to location or line-end-position may be wrong
             (goto-char location)
             (list
              ;; we are converting the location, so we need the line-number
              (line-number-at-pos location)
              ;; and the distance from the end
              (- (line-end-position)
                 location))))))
    (with-current-buffer
        (lentic-that conf)
      (save-excursion
        (goto-char (point-min))
        ;; move forward to the line in question
        (forward-line (1- (car line-plus)))
        ;; don't move from the line in question
        (max (line-beginning-position)
             ;; but move in from the end
             (- (line-end-position)
                (cadr line-plus)))))))


(defclass lentic-commented-chunk-configuration
  (lentic-chunk-configuration)
  ()
  "Configuration for chunked lentic with comments.")

(defclass lentic-uncommented-chunk-configuration
  (lentic-chunk-configuration)
  ()
  "Configuration for chunked lentic without comments.")

(cl-defmethod lentic-clone
  ((conf lentic-commented-chunk-configuration)
   &optional start stop length-before start-converted stop-converted)
  "Update the contents in the lentic without comments"
  ;;(lentic-log "chunk-clone-uncomment (from):(%s)" conf)
  (let*
      ;; we need to detect whether start or stop are in the comment region at
      ;; the beginning of the file. We check this by looking at :that-buffer
      ;; -- if we are in the magic region, then we must be at the start of
      ;; line. In this case, we copy the entire line as it is in a hard to
      ;; predict state. This is slightly over cautious (it also catches first
      ;; character), but this is safe, it only causes the occasional
      ;; unnecessary whole line copy. In normal typing "whole line" will be
      ;; one character anyway
      ((start-in-comment
        (when
            (and start
                 (m-buffer-at-bolp
                  (lentic-that conf)
                  start-converted))
          (m-buffer-at-line-beginning-position
           (lentic-this conf)
           start)))
       (start (or start-in-comment start))
       (start-converted
        (if start-in-comment
          (m-buffer-at-line-beginning-position
           (lentic-that conf)
           start-converted)
          start-converted))
       ;; likewise for stop
       (stop-in-comment
        (when
            (and stop
                 (m-buffer-at-bolp
                  (lentic-that conf)
                  stop-converted))
          (m-buffer-at-line-end-position
              (lentic-this conf)
              stop)))
       (stop (or stop-in-comment stop))
       (stop-converted
        (if stop-in-comment
            (m-buffer-at-line-end-position
                (lentic-that conf)
                stop-converted)
          stop-converted)))
    ;; log when we have gone long
    (if (or start-in-comment stop-in-comment)
        (lentic-log "In comment: %s %s"
                           (when start-in-comment
                             "start")
                           (when stop-in-comment
                             "stop")))
    ;; now clone the buffer, recording the return value unless either the
    ;; start or the stop is in comment, in which case we need a nil.
    (let* ((clone-return
            (cl-call-next-method conf start stop length-before
                                 start-converted stop-converted))
           (clone-return
            (unless (or start-in-comment stop-in-comment)
              clone-return))
           ;; record the validity of the buffer as it was
           (validity (oref conf valid))
           (markers
            (lentic-chunk-marker-boundaries
             conf
             (lentic-that conf))))
      (cond
          ;; we are unmatched, but we used to be valid, which means that we
          ;; have just become invalid, so we want to do a full clone
          ;; straight-away to make sure that both buffers are now identical
          ((and
            (equal :unmatched
                   markers)
            validity)
           (cl-call-next-method conf))
          ;; we are unmatched, and we were unmatched before. We have already
          ;; done the incremental clone, so stop.
          ((equal :unmatched markers)
           nil)
          ;; we have matched delimiters but we were not matched before. This
          ;; means we will have done an identity clone which means that other
          ;; buffer will be all commented up. So remove all comments and clean
          ;; up all the markers
          ((not validity)
           (m-buffer-with-markers
               ((markers markers))
             (lentic-chunk-uncomment-buffer
              conf
              markers
              (lentic-convert conf (point-min))
              (lentic-convert conf (point-max))
              (lentic-that conf))
             ))
          (t
           ;; just uncomment the bit we have cloned.
           (lentic-chunk-uncomment-buffer
            conf
            markers
            ;; the buffer at this point has been copied over, but is in an
            ;; inconsistent state (because it may have comments that it should
            ;; not). Still, the convertor should still work because it counts from
            ;; the end
            (lentic-convert
             conf
             ;; point-min if we know nothing else
             (or start (point-min)))
            (lentic-convert
             conf
             ;; if we have a stop
             (if stop
                 ;; take stop (if we have got longer) or
                 ;; start length before (if we have got shorter)
                 (max stop
                      (+ start length-before))
               (point-max)))
            (lentic-that conf))))
      clone-return)))

(cl-defmethod lentic-invert
  ((conf lentic-commented-chunk-configuration))
  (lentic-uncommented-chunk-configuration
   :this-buffer (lentic-that conf)
   :that-buffer (lentic-this conf)
   :comment (oref conf comment)
   :comment-start (oref conf comment-start)
   :comment-stop (oref conf comment-stop)))

(cl-defmethod lentic-clone
  ((conf lentic-uncommented-chunk-configuration)
   &optional start stop length-before start-converted stop-converted)
  "Update the contents in the lentic without comments."
  ;;(lentic-log "chunk-clone-comment conf):(%s)" conf)
  (let*
      ((start-at-bolp
        (when
            (and start
                 (m-buffer-at-bolp
                  (lentic-this conf)
                  start))
          (m-buffer-at-line-beginning-position
              (lentic-that conf)
              start-converted)))
       (start-converted (or start-at-bolp start-converted)))
    (if (or start-at-bolp)
        (lentic-log "In comment: %s"
                           (when start-at-bolp
                             "start")))
    (let* ((clone-return
            (cl-call-next-method conf start stop length-before
                                 start-converted stop-converted))
           (clone-return
            (unless start-at-bolp
              clone-return))
           (validity (oref conf valid))
           (markers
            (lentic-chunk-marker-boundaries
             conf
             (lentic-that conf))))
      (cond
       ((and (equal :unmatched markers)
             validity)
        (cl-call-next-method conf))

       ((equal :unmatched markers)
        nil)

       ((not validity)
        (m-buffer-with-markers
            ((markers markers))
          (lentic-chunk-comment-buffer
           conf
           markers
           (lentic-convert conf (point-min))
           (lentic-convert conf (point-max))
           (lentic-that conf))))

       (t
        (lentic-chunk-comment-buffer
         conf
         markers
         ;; the buffer at this point has been copied over, but is in an
         ;; inconsistent state (because it may have comments that it should
         ;; not). Still, the convertor should still work because it counts from
         ;; the end
         (lentic-convert
          conf
          ;; point-min if we know nothing else
          (or start (point-min)))
         (lentic-convert
          conf
          ;; if we have a stop
          (if stop
              ;; take stop (if we have got longer) or
              ;; start length before (if we have got shorter)
              (max stop
                   (+ start length-before))
            (point-max)))
         (lentic-that conf))))
      clone-return)))

(cl-defmethod lentic-invert
  ((conf lentic-uncommented-chunk-configuration))
  (lentic-commented-chunk-configuration
   :this-buffer (lentic-that conf)
   :that-buffer (lentic-this conf)
   :comment (oref conf comment)
   :comment-start (oref  conf comment-start)
   :comment-stop (oref conf comment-stop)))


Previous: , Up: Code   [Contents]

6.3.2 Unmatched Chunk Configuration

Unmatched chunks are those when the number of "start" delimitors and "end" delimitors are not the same. The motivating example here was org-mode where the ‘begin_src’ tags name the language but the ‘end_src’ do not. Hence, one org file with two languages break lentic.

The solution is to search for the start tags and then take just the next stop tag, a solution we already use for asciidoc. The disadvantage is that the buffer can no longer become invalid which is useful for detecting accidentally mis-matched tags.

The implementation is provided by the ‘lentic-unmatched-chunk-configuration’ class, which is then mixed-in with the two subclasses.

(defclass lentic-unmatched-chunk-configuration ()
  ()
  :documentation "Configuration for chunked lentics where the
markers are not necessarily paired. Instead for every open chunk
marker, the next close marker is used, and all others are
ignored."
  :abstract t)

(cl-defmethod lentic-chunk-marker-boundaries
  ((conf lentic-unmatched-chunk-configuration)
   buffer)
  "Given CONF, a `lentic-configuration' object, find
demarcation markers. Returns a list of start end cons pairs.
`point-min' is considered to be an implicit start and `point-max'
an implicit stop."
  (let* ((match-chunk
          (lentic-chunk-match
           conf buffer))
         (match-start
          (car match-chunk))
         (match-end
          (cadr match-chunk)))
    (let* ((part
            (-drop-while
             (lambda (n)
               (not (car n)))
             (m-buffer-partition-by-marker
              match-start match-end)))
           (zipped
            (with-current-buffer buffer
              (-zip-with
               #'list
               (cons (point-min-marker)
                     (-map #'cadr part))
               (-snoc
                (-map #'car part)
                (point-max-marker))))))
      zipped)))

(defclass lentic-unmatched-commented-chunk-configuration
  (lentic-unmatched-chunk-configuration
   lentic-commented-chunk-configuration)
  ())

(cl-defmethod lentic-invert
  ((conf lentic-unmatched-commented-chunk-configuration))
  (lentic-unmatched-uncommented-chunk-configuration
   :this-buffer (lentic-that conf)
   :that-buffer (lentic-this conf)
   :comment (oref conf comment)
   :comment-start (oref conf comment-start)
   :comment-stop (oref conf comment-stop)))


(defclass lentic-unmatched-uncommented-chunk-configuration
  (lentic-unmatched-chunk-configuration
   lentic-uncommented-chunk-configuration)
  ())

(cl-defmethod lentic-invert
  ((conf lentic-unmatched-uncommented-chunk-configuration))
  (lentic-unmatched-commented-chunk-configuration
   :this-buffer (lentic-that conf)
   :that-buffer (lentic-this conf)
   :comment (oref conf comment)
   :comment-start (oref conf comment-start)
   :comment-stop (oref conf comment-stop)))

(provide 'lentic-chunk)

;;; lentic-chunk.el ends here

7 Lentic Asciidoc

A lentic block configuration for use with asciidoc.


7.1 Header

This file is not part of Emacs

Author: Phillip Lord <[email protected]> Maintainer: Phillip Lord <[email protected]>

The contents of this file are subject to the GPL License, Version 3.0. ;; Copyright (C) 2014-2022 Free Software Foundation, Inc. ;; 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/.


Next: , Previous: , Up: Lentic Asciidoc   [Contents]

7.2 Commentary

Lentic buffers with asciidoc [source] blocks.


Previous: , Up: Lentic Asciidoc   [Contents]

7.3 Code

(require 'lentic)
(require 'lentic-chunk)
(require 'm-buffer)

(defun lentic-asciidoc-oset (conf)
  (lentic-m-oset
   conf
   'this-buffer (current-buffer)
   'comment ";; "))

(defun lentic-asciidoc-commented-new ()
  (lentic-asciidoc-oset
   (lentic-commented-asciidoc-configuration
    "lb-commented-clojure asciidoc"
    :lentic-file
    (concat
     (file-name-sans-extension
      (buffer-file-name)) ".adoc"))))

;;;###autoload
(defun lentic-clojure-asciidoc-init ()
  (lentic-asciidoc-commented-new))

(add-to-list 'lentic-init-functions #'lentic-clojure-asciidoc-init)

(defun lentic-asciidoc-uncommented-new ()
  (lentic-asciidoc-oset
   (lentic-uncommented-asciidoc-configuration
    "lb-uncommented-clojure-asciidoc"
    :lentic-file
    (concat
     (file-name-sans-extension
      (buffer-file-name)) ".clj"))))

;;;###autoload
(defun lentic-asciidoc-clojure-init ()
  (lentic-asciidoc-uncommented-new))

;;;###autoload
(add-to-list 'lentic-init-functions #'lentic-asciidoc-clojure-init)


;; ** Support Emacs-Lisp
;;;###autoload
(defun lentic-asciidoc-el-init ()
  (lentic-asciidoc-oset
   (lentic-uncommented-asciidoc-configuration
    "temp"
    :lentic-file
    (concat
     (file-name-sans-extension
      buffer-file-name)
     ".el"))))

;;;###autoload
(add-to-list 'lentic-init-functions #'lentic-asciidoc-el-init)

(defclass lentic-commented-asciidoc-configuration
  (lentic-commented-chunk-configuration)
  ((srctags :initarg :srctags
            :documentation "Language tags in source chunk"
            :initform '("clojure" "lisp")))
  "Lentic buffer config for asciidoc and other code.")

(defclass lentic-uncommented-asciidoc-configuration
  (lentic-uncommented-chunk-configuration)
  ((srctags :initarg :srctags
            :documentation "Language tags in source chunk"
            :initform '("clojure" "lisp")))
  "Lentic buffer config for asciidoc and other code")


(defun lentic-splitter (l)
  "Returns a function which for use as a partition predicate.
The returned function returns the first element of L until it is
passed a value higher than the first element, then it returns the
second element and so on."
  #'(lambda (x)
      (when
          (and l
               (< (car l) x))
        (setq l (-drop 1 l)))
      (car l)))

(defun lentic-partition-after-source (l-source l-dots)
  "Given a set of markers l-source, partition the markers in
l-dots.

The source markers represent [source] markers, so we take the
next matches to \"....\" immediately after a [source] marker.
This should remove other \"....\" matches.
"
  (-partition-by
   (lentic-splitter l-source)
   (-drop-while
    (lambda (x)
      (and l-source
           (< x (car l-source))))
    l-dots)))

(defun lentic-chunk-match-asciidoc
  (conf buffer)
  (let* ((source
          (m-buffer-match-begin
           buffer
           (format ";* *\\[source,%s\\]"
                   (regexp-opt
                    (oref conf srctags)))))
         ;; this could also be a start of title
         (dots
          (m-buffer-match buffer
                          "^;* *----"))
         (source-start
          (lentic-partition-after-source
           source
           (m-buffer-match-begin
            dots)))
         (source-end
          (lentic-partition-after-source
           source (m-buffer-match-end dots))))
    (when source
      (list
       (-map 'cadr source-start)
       (-map 'car source-end)))))

(cl-defmethod lentic-chunk-match
  ((conf lentic-commented-asciidoc-configuration) buffer)
  (lentic-chunk-match-asciidoc conf buffer))

(cl-defmethod lentic-chunk-match
  ((conf lentic-uncommented-asciidoc-configuration) buffer)
  (lentic-chunk-match-asciidoc conf buffer))

(cl-defmethod lentic-invert
  ((conf lentic-commented-asciidoc-configuration))
  (lentic-m-oset (lentic-asciidoc-uncommented-new)
                 'that-buffer (lentic-this conf)))

(cl-defmethod lentic-invert
  ((conf lentic-uncommented-asciidoc-configuration))
  (lentic-m-oset (lentic-asciidoc-commented-new)
                 'that-buffer (lentic-this conf)))

(provide 'lentic-asciidoc)
;;; lentic-asciidoc.el ends here


8 Lentic Latex

A lentic block configuration for use with latex.


Next: , Up: Lentic Latex   [Contents]

8.1 Header

This file is not part of Emacs

Author: Phillip Lord <[email protected]> Maintainer: Phillip Lord <[email protected]> Version: 0.1

The contents of this file are subject to the GPL License, Version 3.0.

Copyright (C) 2014-2022 Free Software Foundation, Inc.

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/.


Next: , Previous: , Up: Lentic Latex   [Contents]

8.2 Commentary

A ‘lentic-chunk-configuration’ environment where one buffer is latex and the other is some programming language, with code chunks marked up with a ‘\begin{code}\end{code}’ environment.

The code environment is not normally defined and has been picked for this reason. It avoids defining multiple init functions for different macros; instead the code chunks can be interpreted using what ever environment the author wants, by defining the code environment first.


Previous: , Up: Lentic Latex   [Contents]

8.3 Code

(require 'lentic-chunk)

(defun lentic-latex-clojure-oset (conf)
  (lentic-m-oset
   conf
   'this-buffer (current-buffer)
   'comment ";; "
   'comment-start "\\\\end{code}"
   'comment-stop "\\\\begin{code}"))

(defun lentic-clojure-to-latex-new ()
  (lentic-latex-clojure-oset
   (lentic-commented-chunk-configuration
    :lentic-file
    (concat (file-name-sans-extension buffer-file-name) ".tex"))))

;;;###autoload
(defun lentic-clojure-latex-init ()
  (lentic-clojure-to-latex-new))

(add-to-list 'lentic-init-functions #'lentic-clojure-latex-init)


(defun lentic-latex-to-clojure-new ()
  (lentic-latex-clojure-oset
   (lentic-uncommented-chunk-configuration
    :lentic-file
    (concat (file-name-sans-extension buffer-file-name) ".clj"))))

;;;###autoload
(defun lentic-latex-clojure-init ()
  (lentic-latex-to-clojure-new))

(add-to-list 'lentic-init-functions #'lentic-latex-clojure-init)

;;;###autoload
(defun lentic-clojure-latex-delayed-init ()
  (lentic-delayed-init #'lentic-clojure-latex-init))

(add-to-list 'lentic-init-functions #'lentic-clojure-latex-delayed-init)

;;;###autoload
(defun lentic-haskell-latex-init ()
  (lentic-default-configuration
   :this-buffer (current-buffer)
   :lentic-file
   (concat
    (file-name-sans-extension buffer-file-name)
    ".tex")))

(add-to-list 'lentic-init-functions #'lentic-haskell-latex-init)

(provide 'lentic-latex-code)

;;; lentic-latex-code ends here

9 Lentic Org

A lentic block configuration for use with org. This includes a more specialised and complex transformation between Emacs-Lisp and Org.


Next: , Up: Lentic Org   [Contents]

9.1 Header

This file is not part of Emacs

Author: Phillip Lord <[email protected]> Maintainer: Phillip Lord <[email protected]>

The contents of this file are subject to the GPL License, Version 3.0.

Copyright (C) 2014-2022 Free Software Foundation, Inc.

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/.


Next: , Previous: , Up: Lentic Org   [Contents]

9.2 Commentary

This file provides lentic for org and emacs-lisp files. This enables a literate form of programming with Elisp, using org mode to provide documentation mark up.

It provides too main ways of integrating between org and emacs-lisp. The first which we call org-el (or el-org) is a relatively simple translation between the two modes.

(require 'cl-lib)
(require 'rx)
(require 'lentic-chunk)
(require 'm-buffer-at)

Next: , Previous: , Up: Lentic Org   [Contents]

9.3 Code


Next: , Up: Code   [Contents]

9.3.1 Simple org->el

The simple transformation between org and elisp is to just comment out everything that is not inside a BEGIN_SRC/END_SRC chunk. This provides only minimal advantages over the embedded org mode environment. Org, for instance, allows native fontification of the embedded code (i.e. elisp will be coloured like elisp!), which is something that org-el translation also gives for free; in this case of org-el, however, when the code is high-lighted, the org mode text is visually reduced to ‘comment-face’. The other key advantage is familiarity; it is possible to switch to the ‘emacs-lisp-mode’ buffer and eval-buffer, region or expression using all the standard keypresses.

One problem with this mode is that elisp has a first line semantics for file-local variables. This is a particular issue if setting ‘lexical-binding’. In a literate org file, this might appear on the first line of the embedded lisp, but it will not appear in first line of an emacs-lisp lentic, so the file will be interpreted with dynamic binding.

  1. Implementation

    The implementation is a straight-forward use of ‘lentic-chunk’ with regexps for org source chunks. It currently takes no account of org-mode :tangle directives – so all lisp in the buffer will be present in the emacs-lisp mode lentic.

    (defun lentic-org-oset (conf)
      (lentic-m-oset
       conf
       'this-buffer (current-buffer)
       'comment ";; "
       'comment-stop "#\\+BEGIN_SRC emacs-lisp.*"
       'comment-start "#\\+END_SRC"))
    
    ;;;###autoload
    (defun lentic-org-el-init ()
      (lentic-org-oset
       (lentic-unmatched-uncommented-chunk-configuration
        :lentic-file
        (concat
         (file-name-sans-extension
          buffer-file-name)
         ".el"))))
    
    (add-to-list 'lentic-init-functions #'lentic-org-el-init)
    
    ;;;###autoload
    (defun lentic-el-org-init ()
      (lentic-org-oset
       (lentic-unmatched-commented-chunk-configuration
        :lentic-file
        (concat
         (file-name-sans-extension
          buffer-file-name)
         ".org"))))
    
    (add-to-list 'lentic-init-functions #'lentic-el-org-init)
    

Next: , Previous: , Up: Code   [Contents]

9.3.2 orgel->org

In this section, we define a different transformation from what we call an orgel file. This is a completely valid emacs-lisp file which transforms cleanly into a valid org file. This requires constraits on both the emacs-lisp and org representation. However, most of the features of both modes are available.

The advantages of orgel files over a tangle-able literate org file are several. The main one, however, is that the ‘.el’ file remains a source format. It can be loaded directly by Emacs with ‘load-library’ or ‘require’. Developers downloading from a VCS will find the ‘.el’ file rather than looking for an ‘.org’ file. Developers wishing to offer patches can do so to the ‘.el’ file. Finally, tools which work over ‘.el’ such as checkdoc will still work. Finally, there is no disjoint between the org file and the emacs-lisp comments. The commentary section, for example, can be edited using ‘org-mode’ rather than as comments in an elisp code chunk.

The disadvantages are that the structure of the org file is not arbitrary; it most follow a specific structure. Without an untangling process, things like noweb references will not work.

The transformation (orgel -> org) works as follows:

  • the first line summary is transformed into a comment in org
  • all single word ";;;" headers are transformed into level 1 org headings.
  • ";;" comments are removed except inside emacs-lisp source chunks.
  1. Converting an Existing file

    It is relatively simple to convert an existing emacs-lisp file, so that it will work with the orgel transformation. orgel files work with (nearly) all existing Emacs-Lisp documentaton standards but have a few extra bits added in to work with org.

    Current ";;;" section demarcation headers in emacs-lisp are used directly and are transformed into Section 1 headings in org-mode. Unfortunately, in emacs-lisp the header is not explicitly marked – it’s just the start to the ";;; Commentary:" header. To enable folding of the header, therefore, you need to introduce a ";;; Header:" line after the first line. You may also wish to add a ";;; Footer:" heading as well.

    Secondly, mark all of the code with org-mode source demarks. Finally, set ‘lentic-init’ to ‘lentic-orgel-org-init’ (normally with a file-local or dir-local variable). Now lentic can be started. The header will appear as normal text in the org-mode buffer, with all other comments inside a source chunk. You can now move through the buffer splitting the source chunk (with ‘org-babel-demarcate-block’ which has to win a prize for the most obscurely named command), and move comments out of the source chunk into the newly created text chunk.

  2. Limitations

    Currently, the implementation still requires some extra effort from the elisp side, in that lisp must be marked up as a source code block. The short term fix would be to add some functionality like ‘org-babel-demarcate-block’ to emacs-lisp-mode. Even better would to automatically add source markup when "(" was pressed at top level (if paredit were active, then it would also be obvious where to put the close). Finally, have both ‘lentic-org’ and ‘org-mode’ just recognise emacs-lisp as a source entity without any further markup.

    Finally, I don’t like the treatment of the summary line – ideally this should appear somewhere in the org file not as a comment. I am constrained by the start of file semantics of both ‘.org’ and ‘.el’ so this will probably remain. The content can always be duplicated which is painful, but the summary line is unlikely to get updated regularly.

  3. Implementation

    The main transformation issue is the first line. An ‘.el’ file has a summary at the top. This is checked by checkdoc, used by the various lisp management tools, which in turn impacts on the packaging tools. Additionally, lexical binding really must be set here.

    We solve this problem by transforming the first line ";;;" into "# #". Having three characters means that the width is maintained. It also means I can distinguish between this kind of comment and an "ordinary" ‘org-mode’ comment; in practice, this doesn’t matter, because I only check on the first line. The space is necessary because ‘org-mode’ doesn’t recognised "###" as a comment.

    Another possibility would be to transform the summary line into a header. I choose against this because first it’s not really a header being too long and second ‘org-mode’ uses the space before the first header to specify, for example, properties relevant to the entire tree. This is prevented if I make the first line a header 1.

    1. org to orgel

      Here we define a new class or org-to-orgel, as well as clone function which adds the ";;;" header transformation in addition to the normal chunk semantics from the superclass. Currently only single word headers are allowed which seems consistent with emacs-lisp usage.

      (defclass lentic-org-to-orgel-configuration
        (lentic-unmatched-chunk-configuration lentic-uncommented-chunk-configuration)
        ())
      
      
      (defun lentic-org--first-line-fixup (conf first-line-end)
        "Fixup the first line of an org->orgel file.
      
      This swaps lines of form:
      
      ;; ;;; or
      # #
      
      into
      
      ;;;"
        (m-buffer-replace-match
         (m-buffer-match
          (lentic-that conf)
          ;; we can be in one of two states depending on whether we have made a new
          ;; clone or an incremental change
          (rx
           (and line-start ";; "
                (submatch (or ";;;"
                              "# #"))))
          :end first-line-end)
         ";;;"))
      
      (defun lentic-org--h1-fixup-from-start (conf first-line-end)
        "Fixup h1 with start
      
      This swaps lines of form
      
      ;; * Header
      
      or
      
      ;; * Header    :tag:
      
      into
      
      ;;; Header:    :tag:"
        (m-buffer-replace-match
                 (m-buffer-match
                  (lentic-that conf)
                  (rx
                   (and line-start ";; * "
                        (submatch (1+ word))
                        (optional
                         (submatch
                          (0+ " ")
                          ":" (1+ word) ":"))))
                  :begin first-line-end)
                 ";;; \\1:\\2"))
      
      (defun lentic-org--h1-fixup-from-semi (conf first-line-end)
        "Fixup h1 with semis"
        (m-buffer-replace-match
         (m-buffer-match
          (lentic-that conf)
          (rx
           (and line-start
                ";; ;;; "
                (submatch (1+ word))
                (optional ":")
                (optional
                 (submatch
                  (0+ " ")
                  ":" (1+ word) ":"))))
          :begin first-line-end)
         ";;; \\1:\\2"))
      
      
      (cl-defmethod lentic-clone
        ((conf lentic-org-to-orgel-configuration)
         &optional start stop length-before
         start-converted stop-converted)
        ;; do everything else to the buffer
        (m-buffer-with-markers
            ((first-line
              (m-buffer-match-first-line
               (lentic-this conf)))
             (header-one-line
              (m-buffer-match
               (lentic-this conf)
               (rx line-start
                   "* " (0+ word)
                   (optional (1+ " ")
                             ":" (1+ word) ":")
                   line-end)
               :begin (cl-cadar first-line)))
             (special-lines
              (-concat first-line header-one-line)))
          ;; check whether we are in a special line -- if so widen the change extent
          (let*
              ((start-in-special
                (when
                    (and
                     start
                     (m-buffer-in-match-p
                      special-lines start))
                  (m-buffer-at-line-beginning-position
                   (lentic-this conf)
                   start)))
               (start (or start-in-special start))
               (start-converted
                (if start-in-special
                    (m-buffer-at-line-beginning-position
                     (lentic-that conf)
                     start-converted)
                  start-converted))
               (stop-in-special
                (when
                    (and
                     stop
                     (m-buffer-in-match-p
                      special-lines stop))
                  (m-buffer-at-line-end-position
                   (lentic-this conf)
                   stop)))
               (stop (or stop-in-special stop))
               (stop-converted
                (if stop-in-special
                    (m-buffer-at-line-end-position
                     (lentic-that conf)
                     stop-converted)
                  stop-converted))
               (clone-return
                (cl-call-next-method conf start stop length-before
                                     start-converted stop-converted))
               (first-line-end-match
                (cl-cadar
                 (m-buffer-match-first-line
                  (lentic-that conf))))
               ;; can't just use or here because we need non-short circuiting
               (c1 (lentic-org--first-line-fixup conf first-line-end-match))
               ;; replace big headers, in either of their two states
               (c2 (lentic-org--h1-fixup-from-start conf first-line-end-match))
               (c3 (lentic-org--h1-fixup-from-semi conf first-line-end-match)))
            (if (or start-in-special stop-in-special c1 c2 c3)
                nil
              clone-return))))
      
      (cl-defmethod lentic-convert
        ((conf lentic-org-to-orgel-configuration)
         location)
        (let ((converted (cl-call-next-method conf location)))
          (m-buffer-with-current-position
              (oref conf this-buffer)
              location
            (beginning-of-line)
            (if (looking-at
                 (rx (submatch "* ")
                     (submatch (1+ word))
                     (optional (1+ " ")
                               ":" (1+ word) ":")
                     line-end))
                (cond
                 ((= location (nth 2 (match-data)))
                  (m-buffer-at-line-beginning-position
                   (oref conf that-buffer)
                   converted))
                 ((< location (nth 5 (match-data)))
                  (- converted 1))
                 (t
                  converted))
              converted))))
      
      (cl-defmethod lentic-invert
        ((conf lentic-org-to-orgel-configuration))
        (lentic-m-oset
         (lentic-orgel-org-init)
         'that-buffer
         (lentic-this conf)))
      
      ;;;###autoload
      (defun lentic-org-orgel-init ()
        (lentic-org-oset
         (lentic-org-to-orgel-configuration
          :lentic-file
          (concat
           (file-name-sans-extension
            buffer-file-name)
           ".el"))))
      
      (add-to-list 'lentic-init-functions #'lentic-org-orgel-init)
      
    2. orgel->org

      And the orgel->org implementation. Currently, this means that I have all the various regexps in two places which is a bit ugly. I am not sure how to stop this.

      (defvar lentic-orgel-org-init-hook nil)
      
      ;; shut byte compiler up and define var for setq-local
      (defvar org-archive-default-command)
      
      (defun lentic-orgel-org-init-default-hook (conf)
        ;; Better to open all trees in lentic so that both buffers appears the same
        ;; size.
        (outline-show-all)
        ;; Archiving very easy to and almost always a disaster when it removes an
        ;; entire tree from the buffer.
        (require 'org-archive)
        ;; shorten the fill column by 3, so that the emacs-lisp buffer is the
        ;; correct width.
        (set-fill-column
         (with-current-buffer
             (lentic-that conf)
           (- fill-column 3)))
        (setq-local org-archive-default-command
                    (let ((old-archive
                           org-archive-default-command))
                      (lambda ()
                        (interactive)
                        (if (yes-or-no-p
                             "Really archive in lentic mode? ")
                            (funcall old-archive)
                          (message "Archiving aborted"))))))
      
      (add-hook 'lentic-orgel-org-init-hook
                #'lentic-orgel-org-init-default-hook)
      
      
      (defclass lentic-orgel-to-org-configuration
        (lentic-unmatched-chunk-configuration lentic-commented-chunk-configuration)
        ())
      
      (cl-defmethod lentic-create ((conf lentic-orgel-to-org-configuration))
        (let ((buf
               (cl-call-next-method conf)))
          (with-current-buffer
              buf
            (run-hook-with-args 'lentic-orgel-org-init-hook conf))
          buf))
      
      (cl-defmethod lentic-clone ((conf lentic-orgel-to-org-configuration) &rest _)
        ;; do everything else to the buffer
        (let* ((clone-return (cl-call-next-method))
               (m1
                (m-buffer-replace-match
                 (m-buffer-match
                  (lentic-that conf)
                  ";;; "
                  :end
                  (cl-cadar
                   (m-buffer-match-first-line
                    (lentic-that conf))))
                 "# # "))
               (m2
                (m-buffer-replace-match
                 (m-buffer-match (lentic-that conf)
                                 (rx line-start ";;; "
                                     (submatch (0+ word))
                                     ":"
                                     (optional
                                      (submatch
                                       (0+ " ")
                                       ":" (1+ word) ":"))
                                     line-end))
                 "* \\1\\2")))
          (unless
              ;; update some stuff
              (or m1 m2)
            ;; and return clone-return unless we have updated stuff in which case
            ;; return nil
            clone-return)))
      
      (cl-defmethod lentic-convert
        ((conf lentic-orgel-to-org-configuration)
         location)
        ;; if we are a header one and we are *after* the first :, then just call
        ;; next-method.
        (let* ((cnm
                (cl-call-next-method conf location))
              (line-start-that
               (m-buffer-at-line-beginning-position
                (oref conf that-buffer) cnm))
              (line-start-this
               (m-buffer-at-line-beginning-position
                (oref conf this-buffer) location)))
          (if
              (m-buffer-with-current-position
                  (oref conf this-buffer)
                  location
                (beginning-of-line)
                (looking-at
                 (rx ";;; "
                     (1+ word)
                     (submatch ":")
                     (optional (1+ " ")
                               ":" (1+ word) ":"))))
              ;; hey global state!
              (let ((colon (nth 3 (match-data))))
                ;; if in the comments, just return the start of the
                ;; line, if we are after the comments but before the colon, fudge
                ;; it. If we are after the colon, count from the end
                (cond
                 ((> 3 (- location line-start-this))
                  line-start-that)
                 ((> location colon)
                  cnm)
                 (t
                  (+ cnm 1))))
            cnm)))
      
      (cl-defmethod lentic-invert
        ((conf lentic-orgel-to-org-configuration))
        (lentic-m-oset
         (lentic-org-orgel-init)
         'delete-on-exit t
         'that-buffer (lentic-this conf)))
      
      ;;;###autoload
      (defun lentic-orgel-org-init ()
        (lentic-org-oset
         (lentic-orgel-to-org-configuration
          ;; we don't really need a file and could cope without, but org mode assumes
          ;; that the buffer is file name bound when it exports. As it happens, this
          ;; also means that file saving is possible which in turn saves the el file
          :lentic-file
          (concat
           (file-name-sans-extension
            buffer-file-name)
           ".org"))))
      
      (add-to-list 'lentic-init-functions #'lentic-orgel-org-init)
      
      

Next: , Previous: , Up: Code   [Contents]

9.3.3 org->clojure

(defun lentic-org-clojure-oset (conf)
  (lentic-m-oset
   conf
   'this-buffer (current-buffer)
   'comment ";; "
   'comment-stop "#\\+BEGIN_SRC clojure.*"
   'comment-start "#\\+END_SRC"))

;;;###autoload
(defun lentic-org-clojure-init ()
  (lentic-org-clojure-oset
   (lentic-unmatched-uncommented-chunk-configuration
    :lentic-file
    (concat
     (file-name-sans-extension
      buffer-file-name)
     ".clj"))))

(add-to-list 'lentic-init-functions #'lentic-org-clojure-init)

;;;###autoload
(defun lentic-clojure-org-init ()
  (lentic-org-clojure-oset
   (lentic-unmatched-commented-chunk-configuration
    :lentic-file
    (concat
     (file-name-sans-extension
      buffer-file-name)
     ".org"))))

(add-to-list 'lentic-init-functions #'lentic-clojure-org-init)

Previous: , Up: Code   [Contents]

9.3.4 org->python

(defun lentic-org-python-oset (conf)
  (lentic-m-oset
   conf
   'this-buffer (current-buffer)
   'comment "## "
   'comment-stop "#\\+BEGIN_SRC python.*"
   'comment-start "#\\+END_SRC"))

;;;###autoload
(defun lentic-org-python-init ()
  (lentic-org-python-oset
   (lentic-unmatched-uncommented-chunk-configuration
    :lentic-file
    (concat
     (file-name-sans-extension
      buffer-file-name)
     ".py"))))

(add-to-list 'lentic-init-functions #'lentic-org-python-init)

;;;###autoload
(defun lentic-python-org-init ()
  (lentic-org-python-oset
   (lentic-unmatched-commented-chunk-configuration
    :lentic-file
    (concat
     (file-name-sans-extension
      buffer-file-name)
     ".org"))))

(add-to-list 'lentic-init-functions #'lentic-python-org-init)

10 Lentic Dev

Tools for developers of new configurations.


Next: , Up: Lentic Dev   [Contents]

10.1 Header

This file is not part of Emacs

Author: Phillip Lord <[email protected]> Maintainer: Phillip Lord <[email protected]> The contents of this file are subject to the GPL License, Version 3.0.

Copyright (C) 2014-2024 Free Software Foundation, Inc.

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/.


Next: , Previous: , Up: Lentic Dev   [Contents]

10.2 Commentary

Developing support for new forms of lentic buffers is not trivial. This file provides some support functions for doing so.


Previous: , Up: Lentic Dev   [Contents]

10.3 Code

(require 'lentic)


Next: , Up: Code   [Contents]

10.3.1 Manual Updates

Usually, lentic uses Emacs hooks to percolate changes in one buffer to another. Unfortunately, all the hooks that do this not only silently discard errors, but they delete the offending function from the hook. So, post-mortem debugging is hard. Step-through is also hard since it happens in the command loop.

Lentic has a function for disabling its functionality (due to breakage rather than just normal switching it off), called ‘linked-buffer-emergency’ (and the inverse ‘linked-buffer-unemergency’). In this emergency state, we can still run the hooks manually, which is by far the best way to debug them.

For the ‘lentic-test-after-change-function’ to work ‘lentic-emergency-debug’ must be set. It is also critical that only a single change has happened before this function is called – otherwise the result of the previous change are deleted, and the lentic buffers will update in an inconsistent and haphazard way.

;;;###autoload
(defun lentic-dev-after-change-function ()
  "Run the change functions out of the command loop.
Using this function is the easiest way to test an new
`lentic-clone' method, as doing so in the command loop is
painful for debugging. Set variable `lentic-emergency' to
true to disable command loop functionality."
  (interactive)
  (message "Running after change with args: %s"
           lentic-emergency-last-change)
  (apply #'lentic-after-change-function-1
         lentic-emergency-last-change))

;;;###autoload
(defun lentic-dev-post-command-hook ()
  "Run the post-command functions out of the command loop.
Using this function is the easiest way to test an new
`lentic-convert' method, as doing so in the command loop is
painful for debugging. Set variable `lentic-emergency' to
true to disable command loop functionality."
  (interactive)
  (lentic-post-command-hook-1 (current-buffer) '()))

;;;###autoload
(defun lentic-dev-after-save-hook ()
  (interactive)
  (let ((lentic-emergency nil))
    (lentic-mode-after-save-hook)))

;;;###autoload
(defun lentic-dev-mode-buffer-list-update-hook ()
  (interactive)
  (let ((lentic-emergency nil))
    (lentic-mode-buffer-list-update-hook)))

;;;###autoload
(defun lentic-dev-kill-buffer-hook ()
  (interactive)
  (let ((lentic-emergency nil))
    (lentic-kill-buffer-hook)))

;;;###autoload
(defun lentic-dev-kill-emacs-hook ()
  (interactive)
  (let ((lentic-emergency nil))
    (lentic-kill-emacs-hook)))

;;;###autoload
(defun lentic-dev-reinit ()
  "Recall the init function regardless of current status.
This can help if you have change the config object and need
to make sure there is a new one."
  (interactive)
  (setq lentic-config nil)
  (lentic-ensure-init))


Previous: , Up: Code   [Contents]

10.3.2 Font-Lock changes

These commands enable or disable fontification of changes that lentic has percolated. This is very useful for incremental changes; it’s the only practical way of seeing what has been copied.

The exact behaviour of this depends on the mode of the buffer displaying the lentic buffer. Sometimes, the natural buffer fontification functions just change the font back to whatever the syntax suggests. In this case, try switching off ‘font-lock-mode’.


(defvar lentic-dev-insert-face 'font-lock-keyword-face
  "Start face to use for inserted text.")

;;;###autoload
(defun lentic-dev-random-face ()
  "Change the insertion face to a random one."
  (interactive)
  (setq lentic-dev-insert-face
        (nth (random (length (face-list)))
             (face-list)))
  (message "Insert face is now %s"
           (propertize
            "this"
            'face
            lentic-dev-insert-face)))

(defun lentic-dev--face-transform (string)
  (propertize
   string
   'font-lock-face
   lentic-dev-insert-face
   'face
   lentic-dev-insert-face))

;;;###autoload
(define-minor-mode lentic-dev-enable-insertion-marking
  "Enable font locking properties for inserted text."
  :global t
  :group 'lentic-dev
  (if lentic-dev-enable-insertion-marking
      (advice-add 'lentic-insertion-string-transform :override
                    #'lentic-dev--face-transform)
    (advice-remove 'lentic-insertion-string-transform
                     #'lentic-dev--face-transform)))


(defun lentic-dev--pulse-transform (buffer start stop &rest _)
  (with-current-buffer
      buffer
    (pulse-momentary-highlight-region
     (or start (point-min))
     (or stop (point-max)))))

;;;###autoload
(define-minor-mode lentic-dev-enable-insertion-pulse
  "Enable momentary pulsing for inserted text."
  :global t
  :group 'lentic-dev
  (if lentic-dev-enable-insertion-pulse
      (advice-add 'lentic-after-change-transform :after
                  #'lentic-dev--pulse-transform)
    (advice-remove 'lentic-after-change-transform
                   #'lentic-dev--pulse-transform)))


(defun lentic-dev-edebug-trace-mode ()
  (setq edebug-initial-mode 'continue)
  (setq edebug-trace t))


(defun lentic-dev-highlight-markers ()
  (interactive)
  (m-buffer-overlay-font-lock-face-match
   (lentic-blk-marker-boundaries
    (car lentic-config)
    (current-buffer))
   'highlight))

(provide 'lentic-dev)
;;; lentic-dev.el ends here


11 Lentic Doc

Lentic has a self-hosting documentation system which is defined here.


Next: , Up: Lentic Doc   [Contents]

11.1 Header

This file is not part of Emacs

The contents of this file are subject to the GPL License, Version 3.0.

Copyright (C) 2015-2022 Free Software Foundation, Inc.

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/.


Next: , Previous: , Up: Lentic Doc   [Contents]

11.2 Commentary

Lentic’s self-hosting documentation system.


Previous: , Up: Lentic Doc   [Contents]

11.3 Code

(require 'eww)
(require 'ox-html)
(require 'browse-url)
(require 'lentic)
(require 'lentic-org)
(require 'lentic-ox)
(defvar lentic-doc--includes
    '(("http://phillord.github.io/lentic/include/lenticular.css" .
       "include/lenticular.css")
      ("http://orgmode.org/org-info.js" .
       "include/org-info.js")
      ))

Next: , Up: Code   [Contents]

11.3.1 Orgify Package

(defun lentic-doc-stringify (str-or-sym)
  (if (symbolp str-or-sym)
      (symbol-name str-or-sym)
    str-or-sym))

(defun lentic-doc-all-files-of-package (package)
  "Fetch all the files that are part of package.
This function assumes that all the files are in one place and
follow the standard naming convention of using the package name
as a prefix. "
  (let* ((main-file
          (locate-library package))
         (dir
          (file-name-directory main-file))
         (prefix
          (concat dir package))
         (others
          (file-expand-wildcards
           (concat prefix "*.el")))
         (scripts
          (file-expand-wildcards
           (concat prefix "*.els"))))
    (-remove
     (lambda (file)
       ;; FIXME: Shouldn't this regexp have a \\' to make sure it matches the
       ;; end of the name?
       (string-match-p "-\\(pkg\\|autoloads\\).el" file))
     (append others scripts))))

(defun lentic-doc-orgify-if-necessary (file)
  (let* ((target
          (concat
           (file-name-sans-extension file)
           ".org"))
         (locked
          (or (file-locked-p file)
              (file-locked-p target)))
         (open
          (or
           (get-file-buffer file)
           (get-file-buffer target))))
    (unless (or locked open)
      (when (file-newer-than-file-p file target)
        (let ((lentic-kill-retain t))
          (lentic-batch-clone-and-save-with-config
           file 'lentic-orgel-org-init))))))

(defun lentic-doc-orgify-all-if-necessary (files)
  (-map 'lentic-doc-orgify-if-necessary files))

(defun lentic-doc-orgify-package (package)
  (lentic-doc-orgify-all-if-necessary
   (lentic-doc-all-files-of-package
    (lentic-doc-stringify package))))

Previous: , Up: Code   [Contents]

11.3.2 htmlify package

(defun lentic-doc-htmlify-package (package)
  (let ((package
         (lentic-doc-stringify package)))
    (lentic-doc-orgify-package package)
    (with-current-buffer
        (find-file-noselect
         (lentic-doc-package-start-source package))
      (lentic-ox-html-export-to-html))))
;; remove when it gets into f.el
(defun lentic-f-swap-ext (file ext)
  "Return FILE but with EXT as the new extension.
EXT must not be nil or empty."
  (if (member ext '(nil ""))
      (error "extension cannot be empty or nil")
    (concat (file-name-sans-extension file) "." ext)))

(defun lentic-doc-package-start-source (package)
  (let ((doc-var
         (intern
          (concat package "-doc"))))
    (if (boundp doc-var)
        ;; if it is set to a boolean return the implicit start
        (if (booleanp
             (symbol-value doc-var))
            (lentic-doc-package-implicit-start-source package)
          (expand-file-name
           (symbol-value doc-var)
           (file-name-directory (locate-library package))))
      ;; get the default
      (let*
          ((main-file
            (locate-library package))
           (doc-file
            (when main-file
              (expand-file-name
               (concat
                (file-name-sans-extension main-file)
                "-doc.org")
               (file-name-directory main-file)))))
        (when
            (and doc-file
                 (file-exists-p doc-file))
            doc-file)))))

(defun lentic-doc-package-implicit-start-source (package)
  (-if-let (lib (locate-library package))
      (let ((start
              (lentic-f-swap-ext
               lib
               "org")))
        (if (file-exists-p start)
            start))))

(defun lentic-doc-package-doc-file (package)
  (lentic-f-swap-ext
   (lentic-doc-package-start-source package)
   "html"))


(defvar lentic-doc-allowed-files nil)

(defun lentic-doc-ensure-allowed-html (package)
  (let ((var (intern (concat package "-doc-html-files"))))
    (if (boundp var)
        (mapc
         (lambda (f)
           (add-to-list 'lentic-doc-allowed-files f))
         (symbol-value var)))))

(defun lentic-doc-ensure-doc (package)
  (lentic-doc-ensure-allowed-html package)
  (unless (file-exists-p
           (lentic-doc-package-doc-file package))
    (lentic-doc-htmlify-package package)))

(defvar lentic-doc-lentic-features nil)
(defun lentic-doc-all-lentic-features-capture()
  (setq lentic-doc-lentic-features
        (cons
         (length features)
         (-map
          (lambda (feat)
            (symbol-name feat))
          (-filter
           (lambda (feat)
             (lentic-doc-package-start-source
              (symbol-name feat)))
           features)))))

(defun lentic-doc-all-lentic-features ()
  (unless
      (and lentic-doc-lentic-features
           (equal
            (car lentic-doc-lentic-features)
            (length features)))
    (lentic-doc-all-lentic-features-capture))
  (cdr lentic-doc-lentic-features))

(defun lentic-doc-external-view (package)
  (interactive
   (list
    (completing-read
     "Package Name: "
     (lentic-doc-all-lentic-features))))
  (let ((package (lentic-doc-stringify package)))
    (lentic-doc-ensure-doc package)
    (browse-url-default-browser
     (lentic-doc-package-doc-file package))))

(defun lentic-doc-eww-view (package)
  (interactive
   (list
    (completing-read
     "Package Name: "
     (lentic-doc-all-lentic-features))))
  (let ((package (lentic-doc-stringify package)))
    (lentic-doc-ensure-doc package)
    (eww-open-file
     (lentic-doc-package-doc-file package))))


(provide 'lentic-doc)