[nongnu] elpa/dslide 907e004bca 226/230: Configurable header function

[ELPA Syncer]

branch: elpa/dslide
commit 907e004bca401596a84a8850a2c2cd2f86ac2512
Author: Psionik K <73710933+psionic-k@users.noreply.github.com>
Commit: Psionik K <73710933+psionic-k@users.noreply.github.com>

    Configurable header function
    
    The default is made public.  The signature is changed to accomadate the user
    providing just one function, which is used to clean up or draw a new heading
    with breadcrumbs as it needs to
---
 dslide.el | 139 ++++++++++++++++++++++++++++++++++++--------------------------
 1 file changed, 81 insertions(+), 58 deletions(-)

diff --git a/dslide.el b/dslide.el
index e3b2f4c80c..db6f199a4c 100644
--- a/dslide.el
+++ b/dslide.el
@@ -147,6 +147,25 @@ visible, albeit scrolled away because of how `org-overview'
 works."
   :type 'boolean)
 
+(defcustom dslide-header-fun nil
+  "Custom function to override heading generation.
+The function you define should accept two arguments:
+
+- CLEANUP: meaning to delete any state that was created for an
+  existing header.
+
+- optional BREADCRUMBS: indicating if creating breadcrumbs is
+  appropriate or not, such as when displaying the contents view.
+
+🚧 This option is experimental and the signature is subject to
+change.
+
+When nil, the header is generated by the default
+`dslide-make-header', which respects many customize options.
+However, you may find it faster to completely replace this
+function to get exactly what you want."
+  :type 'function)
+
 (defcustom dslide-header-author t
   "Show the email in the header.
 If there is a #+author: keyword, it will be used."
@@ -1586,7 +1605,9 @@ restriction, meaning no progress was made.")
         ;; global value and then refine with explicit per-slide options.
         (when dslide-header
           (let ((dslide-header (oref obj header)))
-            (dslide--make-header (null (oref obj breadcrumbs)))))
+            (funcall (or dslide-header-fun
+                         #'dslide-make-header)
+                     nil (oref obj breadcrumbs))))
         (mapc
          (lambda (w) (set-window-point w (point-min))) ; reset the scroll
          (get-buffer-window-list (current-buffer) nil t))
@@ -2222,57 +2243,61 @@ used as a name of the slide author.")
 If you have \"#+date:\" line in your org buffer, it will be used
 as the date.")
 
-;; TODO make public
-;; TODO allow header override function
-(defun dslide--make-header (&optional no-breadcrumbs)
+(defun dslide-make-header (cleanup &optional breadcrumbs)
   "Draw a header for the first tree in the restriction.
-Set optional NO-BREADCRUMBS to non-nil to skip breadcrumbs.  The implementation
-assumes the buffer is restricted and that there is a first tree."
-  (dslide--delete-header)
-
-  ;; Use of point-min is an implementation assumption, that the header is 
always
-  ;; at the very top of the narrowed region and never wanted anywhere else.
-  (setq dslide--header-overlay
-        (make-overlay (point-min) (+ 1 (point-min))))
-
-  (let* ((keywords (org-collect-keywords
-                    '("TITLE" "EMAIL" "AUTHOR" "DATE")))
-         (title (or dslide-title
-                    (cadr (assoc-string "TITLE" keywords))
-                    (buffer-name)))
-         (author (or dslide-author
-                     (cadr (assoc "AUTHOR" keywords))))
-         (date (or dslide-date
-                   (cadr (assoc-string "DATE" keywords))
-                   (format-time-string "%Y-%m-%d")))
-         (email (when-let ((email (or dslide-email
-                                      (cadr (assoc-string "EMAIL" keywords)))))
-                  (concat "<" email ">"))))
-
-    ;;  The calls to `propertize' make up for the fact that these values may be
-    ;;  strings, set from elsewhere, but we want to display these strings as if
-    ;;  they were fontified within the buffer.
-    (if dslide-header
-        (overlay-put
-         dslide--header-overlay 'before-string
-         (concat (dslide--margin-lines dslide-margin-title-above)
-                 (propertize title 'face '(org-document-title default))
-                 (dslide--margin-lines dslide-margin-title-below)
-                 (when (and  dslide-header-date date)
-                   (dslide--info-face (concat date "  ")))
-                 (when (and  dslide-header-author author)
-                   (dslide--info-face (concat author "  ")))
-                 (when (and  dslide-header-email email)
-                   (dslide--info-face (concat email "  ")))
-                 (when (and (not no-breadcrumbs)
-                            dslide-breadcrumb-separator)
-                   (concat (dslide--info-face "\n")
-                           (dslide--get-parents
-                            dslide-breadcrumb-separator)))
-                 (dslide--margin-lines dslide-margin-content)))
-
-      (overlay-put dslide--header-overlay 'before-string
-                   (dslide--margin-lines dslide-margin-content)))))
+CLEANUP is non-nil if we are only cleaning up state.
+
+Set optional BREADCRUMBS to non-nil to create breadcrumbs.  The
+implementation assumes the buffer is restricted and that there is
+a first tree.  You may use `dslide-overlays' to benefit
+from existing state cleanup."
+  (when dslide--header-overlay
+        (delete-overlay dslide--header-overlay))
+
+  (unless cleanup
+    ;; Use of point-min is an implementation assumption, that the header is 
always
+    ;; at the very top of the narrowed region and never wanted anywhere else.
+    (setq dslide--header-overlay
+          (make-overlay (point-min) (+ 1 (point-min))))
+
+    (let* ((keywords (org-collect-keywords
+                      '("TITLE" "EMAIL" "AUTHOR" "DATE")))
+           (title (or dslide-title
+                      (cadr (assoc-string "TITLE" keywords))
+                      (buffer-name)))
+           (author (or dslide-author
+                       (cadr (assoc "AUTHOR" keywords))))
+           (date (or dslide-date
+                     (cadr (assoc-string "DATE" keywords))
+                     (format-time-string "%Y-%m-%d")))
+           (email (when-let ((email (or dslide-email
+                                        (cadr (assoc-string "EMAIL" 
keywords)))))
+                    (concat "<" email ">"))))
+
+      ;;  The calls to `propertize' make up for the fact that these values may 
be
+      ;;  strings, set from elsewhere, but we want to display these strings as 
if
+      ;;  they were fontified within the buffer.
+      (if dslide-header
+          (overlay-put
+           dslide--header-overlay 'before-string
+           (concat (dslide--margin-lines dslide-margin-title-above)
+                   (propertize title 'face '(org-document-title default))
+                   (dslide--margin-lines dslide-margin-title-below)
+                   (when (and  dslide-header-date date)
+                     (dslide--info-face (concat date "  ")))
+                   (when (and  dslide-header-author author)
+                     (dslide--info-face (concat author "  ")))
+                   (when (and  dslide-header-email email)
+                     (dslide--info-face (concat email "  ")))
+                   (when (and breadcrumbs
+                              dslide-breadcrumb-separator)
+                     (concat (dslide--info-face "\n")
+                             (dslide--get-parents
+                              dslide-breadcrumb-separator)))
+                   (dslide--margin-lines dslide-margin-content)))
+
+        (overlay-put dslide--header-overlay 'before-string
+                     (dslide--margin-lines dslide-margin-content))))))
 
 (defun dslide--info-face (s)
   (propertize s 'face '(org-document-info default)))
@@ -2315,11 +2340,6 @@ assumes the buffer is restricted and that there is a 
first tree."
                                     breadcrumbs))
           breadcrumbs)))))
 
-(defun dslide--delete-header ()
-  "Delete header."
-  (when dslide--header-overlay
-    (delete-overlay dslide--header-overlay)))
-
 ;; * Animation
 
 (defun dslide-animation-peel (overlay)
@@ -2428,7 +2448,10 @@ and the value of `point-max' should contain a newline 
somewhere."
 
 (defun dslide--cleanup-state ()
   "Clean up states between contents and slides."
-  (dslide--delete-header)
+  (when dslide-header
+    (funcall (or dslide-header-fun
+                 #'dslide-make-header)
+             t nil))
   (dslide--delete-overlays)
   (dslide--animation-cleanup)
   ;; TODO oref & oset outside of class
@@ -2800,7 +2823,7 @@ each slide show from the contents view."
   (run-hooks 'dslide-narrow-hook)
 
   (when dslide-header
-    (dslide--make-header t))
+    (funcall (or dslide-header-fun #'dslide-make-header) nil nil))
 
   (when dslide-contents-selection-highlight
     (add-hook 'post-command-hook #'dslide--contents-hl-line nil t))