[elpa] externals/org-modern de53b5563d 2/6: Support per-block replacements

[ELPA Syncer]

branch: externals/org-modern
commit de53b5563d140e7f995703399fd33b41d0f54586
Author: TEC <tec@tecosaur.com>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    Support per-block replacements
    
    In the process `org-modern-block' is replaced with the more idiomatic
    `org-modern-block-name', and `org-modern-block-keyword' with
    `org-modern-block-name'.
---
 org-modern.el | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 60 insertions(+), 11 deletions(-)

diff --git a/org-modern.el b/org-modern.el
index 5138302347..069d419df4 100644
--- a/org-modern.el
+++ b/org-modern.el
@@ -162,9 +162,23 @@ and faces in the cdr. Example:
   "Prettify tags in headlines, e.g., :tag1:tag2:."
   :type 'boolean)
 
-(defcustom org-modern-block t
-  "Prettify blocks, wrapped by #+begin and #+end keywords."
-  :type 'boolean)
+(defcustom org-modern-block-name t
+  "Prettify blocks names, i.e. #+begin_NAME and #+end_NAME lines.
+If set to a list of two strings, e.g. (\"‣\" \"‣\"), the strings are
+used as replacements for the #+begin_ and #+end_ prefixes, respectively.
+If set to an alist of block names and cons cells of strings, the associated
+strings will be used as a replacements for the whole of #+begin_NAME and
+#+end_NAME, respectively, and the association with t treated as the value for
+all other blocks."
+  :type '(choice (boolean :tag "Hide #+begin_ and #+end_ prefixes")
+                 (cons (string :tag "#+begin_ replacement")
+                       (string :tag "#+end_ replacement"))
+                 (const :tag "Triangle bullets" ("‣" . "‣"))
+                 (alist :key-type (choice (string :tag "Block")
+                                          (const :tag "Default" t))
+                        :value-type (choice (list (string :tag "#+begin_NAME 
replacement")
+                                                  (string :tag "#+end_NAME 
replacement"))
+                                            (boolean :tag "Hide #+begin_ and 
#+end_ prefixes")))))
 
 (defcustom org-modern-block-fringe t
   "Add a bitmap fringe to blocks."
@@ -227,7 +241,7 @@ You can specify a font `:family'. The font families 
`Iosevka', `Hack' and
   `((t :height 0.9 :width condensed :weight regular :underline nil))
   "Parent face for labels.")
 
-(defface org-modern-block-keyword
+(defface org-modern-block-name
   '((t :height 0.8 :weight light))
   "Face used for block keywords.")
 
@@ -304,6 +318,28 @@ You can specify a font `:family'. The font families 
`Iosevka', `Hack' and
 (defvar-local org-modern--checkbox-cache nil)
 (defvar-local org-modern--progress-cache nil)
 
+(defun org-modern--block-name ()
+  "Prettify block according to `org-modern-block-name'."
+  (let ((beg (match-beginning 1))
+        (beg-name (match-beginning 2))
+        (end (match-end 2))
+        (end-rep (match-end 2))
+        (rep (assoc (match-string 2) org-modern-block-name)))
+    (unless rep
+      (setq rep (assq t org-modern-block-name)
+            end-rep beg-name))
+    (setq rep (if (consp (cdr rep))
+                  (if (= 8 (length (match-string 1)))
+                      (cadr rep) (caddr rep))
+                (cdr rep)))
+    (cond
+     ((eq rep 't)
+      (put-text-property beg beg-name 'invisible t)
+      (add-face-text-property beg-name end 'org-modern-block-name))
+     ((stringp rep)
+      (put-text-property beg end-rep 'display
+                         (propertize rep 'face 'org-modern-symbol))))))
+
 (defun org-modern--checkbox ()
   "Prettify checkboxes according to `org-modern-checkbox'."
   (let ((beg (match-beginning 1))
@@ -580,13 +616,26 @@ You can specify a font `:family'. The font families 
`Iosevka', `Hack' and
       (when org-modern-block-fringe
         '(("^[ \t]*#\\+\\(?:begin\\|BEGIN\\)_\\S-"
            (0 (org-modern--block-fringe)))))
-      (when org-modern-block
-        '(("^\\([ \t]*#\\+\\(?:begin\\|BEGIN\\)_\\)\\(\\S-+\\)"
-           (1 '(face nil display (space :width (3))))
-           (2 'org-modern-block-keyword append))
-          ("^\\([ \t]*#\\+\\(?:end\\|END\\)_\\)\\(\\S-+\\)"
-           (1 '(face nil display (space :width (3))))
-           (2 'org-modern-block-keyword append))))
+      (when-let ((block-specs
+                  (cond
+                   ((eq org-modern-block-name t) ; hide
+                    '(((1 '(face nil invisible t))
+                       (2 'org-modern-block-name append)) .
+                       ((1 '(face nil invisible t))
+                        (2 'org-modern-block-name append))))
+                   ((and (consp org-modern-block-name) ; static replacement
+                         (stringp (car org-modern-block-name)))
+                    `(((1 '(face nil display ,(car org-modern-block-name)))
+                       (2 'org-modern-block-name append)) .
+                       ((1 '(face nil display ,(cadr org-modern-block-name)))
+                        (2 'org-modern-block-name append))))
+                   ((and (consp org-modern-block-name) ; dynamic replacement
+                         (consp (car org-modern-block-name)))
+                    '(((0 (org-modern--block-name))) . ((0 
(org-modern--block-name))))))))
+        `(("^[ \t]*\\(#\\+\\(?:begin\\|BEGIN\\)_\\)\\(\\S-+\\).*"
+           ,@(car block-specs))
+          ("^[ \t]*\\(#\\+\\(?:end\\|END\\)_\\)\\(\\S-+\\).*"
+           ,@(cdr block-specs))))
       (when org-modern-tag
         `((,(concat "^\\*+.*?\\( \\)\\(:\\(?:" org-tag-re ":\\)+\\)[ \t]*$")
            (0 (org-modern--tag)))))