[elpa] externals/lentic 92af154760 264/333: Enables tags on section headers.

[ELPA Syncer]

branch: externals/lentic
commit 92af1547600855d63964a12399d0360210ed66ac
Author: Phillip Lord <phillip.lord@newcastle.ac.uk>
Commit: Phillip Lord <phillip.lord@newcastle.ac.uk>

    Enables tags on section headers.
    
    Previously, it was not possible to use tags on section headers, which
    interfereswith a lot of org-mode functionality. This commit also
    includes significant refactoring to simplify the orgel clone functions.
    
    Closes #19
---
 .gitignore                            |   1 +
 Makefile                              |   1 +
 dev-resources/orgel-org-with-tags.el  |  21 +++++
 dev-resources/orgel-org-with-tags.org |  21 +++++
 examples/orgel-org-with-tags.el       |  31 +++++++
 lentic-dev.el                         |   1 +
 lentic-org.el                         | 167 ++++++++++++++++++++++++++++------
 lentic.el                             |   4 +-
 noisy-change.el                       |   8 ++
 test/lentic-test.el                   |  11 ++-
 10 files changed, 237 insertions(+), 29 deletions(-)

diff --git a/.gitignore b/.gitignore
index d3170465ac..f8d78ede8f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -34,3 +34,4 @@ Makefile-local
 /examples/org-python.py
 /examples/many-multi-block-comment-copy.tex
 /dev-resources/asciidoc-clj.clj
+/examples/orgel-org-with-tags.org
diff --git a/Makefile b/Makefile
index 4d6e8e5953..0b8e7c5406 100644
--- a/Makefile
+++ b/Makefile
@@ -1,3 +1,4 @@
+
 EMACS ?= /usr/local/bin/emacs
 CASK ?= cask
 
diff --git a/dev-resources/orgel-org-with-tags.el 
b/dev-resources/orgel-org-with-tags.el
new file mode 100644
index 0000000000..88fdbef227
--- /dev/null
+++ b/dev-resources/orgel-org-with-tags.el
@@ -0,0 +1,21 @@
+;;; orgel-el-with-tags.el -- an example file
+
+;;; Header:
+
+;;; Commentary:
+
+;; This file is a test file to see if we can have tags on headers.
+
+;;; Code:
+
+;; #+begin_src emacs-lisp
+(message "Hello World")
+;; #+end_src
+
+;;; HeaderOne:                                                             
:tag:
+
+;; This is a level 1 header with a tag.
+
+;; ** HeaderTwo                                                     
:anothertag:
+
+;; This is a level 2 header with a tag
diff --git a/dev-resources/orgel-org-with-tags.org 
b/dev-resources/orgel-org-with-tags.org
new file mode 100644
index 0000000000..7d1c715a30
--- /dev/null
+++ b/dev-resources/orgel-org-with-tags.org
@@ -0,0 +1,21 @@
+# # orgel-el-with-tags.el -- an example file
+
+* Header
+
+* Commentary
+
+This file is a test file to see if we can have tags on headers.
+
+* Code
+
+#+begin_src emacs-lisp
+(message "Hello World")
+#+end_src
+
+* HeaderOne                                                             :tag:
+
+This is a level 1 header with a tag.
+
+** HeaderTwo                                                     :anothertag:
+
+This is a level 2 header with a tag
diff --git a/examples/orgel-org-with-tags.el b/examples/orgel-org-with-tags.el
new file mode 100644
index 0000000000..321b6ac320
--- /dev/null
+++ b/examples/orgel-org-with-tags.el
@@ -0,0 +1,31 @@
+;;; orgel-el-with-tags.el -- an example file
+
+;;; Header:
+
+;;; Commentary:
+
+;; This file is a test file to see if we can have tags on headers.
+
+;;; Code:
+
+;; #+begin_src emacs-lisp
+(message "Hello World")
+;; #+end_src
+
+;;; Hello:                                                                     
           :tag:
+
+
+
+
+;; This is a level 1 header with a tag.
+
+;; ** HeaderTwo                             :anothertag:
+
+;; This is a level 2 header with a tag
+
+;; ** HeaderTwo   Hello                                                    
:bob:
+
+
+;; Local Variables:
+;; lentic-init: lentic-orgel-org-init
+;; End:
diff --git a/lentic-dev.el b/lentic-dev.el
index 4c3aa29460..0c39fa5cc6 100644
--- a/lentic-dev.el
+++ b/lentic-dev.el
@@ -109,6 +109,7 @@ true to disable command loop functionality."
 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)
   (funcall lentic-init))
 
 ;; #+end_src
diff --git a/lentic-org.el b/lentic-org.el
index a3d24d6d72..dc169e2c9d 100644
--- a/lentic-org.el
+++ b/lentic-org.el
@@ -37,6 +37,7 @@
 
 ;; #+BEGIN_SRC emacs-lisp
 (require 'cl-lib)
+(require 'rx)
 (require 'lentic-block)
 (require 'm-buffer-at)
 ;; #+END_SRC
@@ -208,6 +209,75 @@
   (lentic-unmatched-block-configuration lentic-uncommented-block-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"))
+
+
 (defmethod lentic-clone
   ((conf lentic-org-to-orgel-configuration)
    &optional start stop length-before
@@ -220,7 +290,11 @@
        (header-one-line
         (m-buffer-match
          (lentic-this conf)
-         "^[*] \\(\\w*\\)$"
+         (rx line-start
+             "* " (0+ word)
+             (optional (1+ " ")
+                       ":" (1+ word) ":")
+             line-end)
          :begin (cl-cadar first-line)))
        (special-lines
         (-concat first-line header-one-line)))
@@ -266,29 +340,10 @@
            (m-buffer-match-first-line
             (lentic-that conf))))
          ;; can't just use or here because we need non-short circuiting
-         (c1
-          (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
-            "^;; \\(;;;\\|# #\\)"
-            :end first-line-end-match)
-           ";;;"))
+         (c1 (lentic-org--first-line-fixup conf first-line-end-match))
          ;; replace big headers, in either of their two states
-         (c2
-          (m-buffer-replace-match
-           (m-buffer-match
-            (lentic-that conf)
-            "^;; [*] \\(\\w*\\)$"
-            :begin first-line-end-match)
-           ";;; \\1:"))
-         (c3
-          (m-buffer-replace-match
-           (m-buffer-match (lentic-that conf)
-                           "^;; ;;; \\(\\w*:\\)$"
-                           :begin first-line-end-match)
-           ";;; \\1")))
+         (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))))
@@ -301,8 +356,21 @@
         (oref conf :this-buffer)
         location
       (beginning-of-line)
-      (if (looking-at "[*] \\w*$")
-          (- converted 1)
+      (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))))
 
 (defmethod lentic-invert
@@ -367,8 +435,15 @@
          (m2
           (m-buffer-replace-match
            (m-buffer-match (lentic-that conf)
-                           "^;;; \\(\\\w*\\):")
-           "* \\1")))
+                           (rx line-start ";;; "
+                               (submatch (0+ word))
+                               ":"
+                               (optional
+                                (submatch
+                                 (0+ " ")
+                                 ":" (1+ word) ":"))
+                               line-end))
+           "* \\1\\2")))
     (unless
         ;; update some stuff
         (or m1 m2)
@@ -376,6 +451,44 @@
       ;; return nil
       clone-return)))
 
+(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
+         (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)))
+
 (defmethod lentic-invert
   ((conf lentic-orgel-to-org-configuration))
   (lentic-m-oset
diff --git a/lentic.el b/lentic.el
index 8c6e3621f7..465ba37a86 100644
--- a/lentic.el
+++ b/lentic.el
@@ -1099,7 +1099,9 @@ SEEN-BUFFER is a list of buffers to which the change has 
been percolated."
     (-map
      (lambda (config)
        (unless
-           (-contains? seen-buffer (lentic-that config))
+           (or (-contains? seen-buffer (lentic-that config))
+               ;; convert uses that buffer
+               (not (buffer-live-p (lentic-that config))))
          (oset config :last-change-start start)
          (oset config
                :last-change-start-converted
diff --git a/noisy-change.el b/noisy-change.el
index ebbd8aa224..f22b2dc694 100644
--- a/noisy-change.el
+++ b/noisy-change.el
@@ -31,6 +31,14 @@
 (defvar noisy-change-log nil)
 (make-variable-buffer-local 'noisy-change-log)
 
+(defun noisy-change-toggle ()
+  (interactive)
+  (if noisy-change-log
+      (progn (setq noisy-change-log nil)
+             (message "Noise-change off"))
+    (setq noisy-change-log t)
+    (message "noisy-change on")))
+
 (defmacro noisy-change-log (&rest rest)
   "Log REST."
   `(when noisy-change-log
diff --git a/test/lentic-test.el b/test/lentic-test.el
index 148a16b2cb..95f6f9d682 100644
--- a/test/lentic-test.el
+++ b/test/lentic-test.el
@@ -29,7 +29,7 @@
       (error "Test File does not exist: %s" file))
     file))
 
-(defvar lentic-test-quiet t)
+(defvar lentic-test-quiet nil)
 
 (defun lentic-test-equal-loudly (a b)
   "Actually, this just tests equality and shouts if not."
@@ -162,6 +162,15 @@
     "org-orgel.org" "org-orgel.el")))
 
 
+(ert-deftest lentic-orgel-org-with-tags ()
+  "Test that we can have tags on section headers.
+
+Addresses issue #19."
+  (should
+   (lentic-test-clone-equal
+    'lentic-orgel-org-init
+    "orgel-org-with-tags.el" "orgel-org-with-tags.org")))
+
 (ert-deftest lentic-org-clojure ()
   (should
    (lentic-test-clone-equal