branch: externals/org-modern
commit 6b925b71eed8a10e1bb33f1bb066a4ff291f3c80
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
Add org-modern-label-border, do not overwrite line-spacing
---
README.org | 4 ++++
org-modern.el | 43 ++++++++++++++++++++++++++-----------------
2 files changed, 30 insertions(+), 17 deletions(-)
diff --git a/README.org b/README.org
index c007182fbb..a22ec61449 100644
--- a/README.org
+++ b/README.org
@@ -46,3 +46,7 @@ hook list.
#+begin_src emacs-lisp
(add-hook 'org-mode-hook #'org-modern-mode)
#+end_src
+
+Note that =org-modern-mode= tries to adjust the tag label display based on the
+value of =line-spacing=. This looks best if =line-spacing= has a value between
0.1
+and 0.4 in the Org buffer.
diff --git a/org-modern.el b/org-modern.el
index 9651568f05..2f31ae296c 100644
--- a/org-modern.el
+++ b/org-modern.el
@@ -39,9 +39,29 @@
:group 'org
:prefix "org-modern-")
-(defcustom org-modern-line-spacing 7
- "Line spacing, should approximately match the box line width."
- :type '(choice (const nil) integer))
+(defvar org-modern-label-border)
+(defun org-modern--update-label-face ()
+ "Update border of the `org-modern-label' face."
+ (when (facep 'org-modern-label)
+ (set-face-attribute
+ 'org-modern-label nil :box
+ (when org-modern-label-border
+ (let ((border (if (eq org-modern-label-border 'auto)
+ (max 3 (cond
+ ((integerp line-spacing) line-spacing)
+ ((floatp line-spacing) (ceiling (*
line-spacing (frame-char-height))))
+ (t (/ (frame-char-height) 10))))
+ org-modern-label-border)))
+ `(:color ,(face-attribute 'default :background nil t) :line-width ,(-
border)))))))
+
+(defcustom org-modern-label-border 'auto
+ "Line width used for tag label borders.
+If set to `auto' the border width is computed based on the `line-spacing'.
+A value between 0.1 and 0.4 of `line-spacing' is recommended."
+ :type '(choice (const nil) integer)
+ :set (lambda (sym val)
+ (set sym val)
+ (org-modern--update-label-face)))
(defcustom org-modern-star ["◉""○""◈""◇""⁕"]
"Replacement strings for headline stars for each level.
@@ -134,8 +154,8 @@ Set to nil to disable the progress bar."
:inherit variable-pitch
:width condensed :weight regular
:underline nil
- ,@(and org-modern-line-spacing
- `(:box (:line-width ,(- org-modern-line-spacing))))))
+ ,@(and (integerp org-modern-label-border)
+ `(:box (:line-width ,(- org-modern-label-border))))))
"Parent face for labels.")
(defface org-modern-block-keyword
@@ -201,9 +221,6 @@ Set to nil to disable the progress bar."
(defvar-local org-modern--keywords nil
"List of font lock keywords.")
-(defvar-local org-modern--orig-line-spacing 'unset
- "Original line spacing.")
-
(defun org-modern--priority ()
"Prettify headline priorities using the `org-modern-priority' character."
(let ((beg (match-beginning 1))
@@ -404,18 +421,10 @@ Set to nil to disable the progress bar."
"Modern looks for Org."
:global nil
:group 'org-modern
- (unless (eq org-modern--orig-line-spacing 'unset)
- (setq line-spacing org-modern--orig-line-spacing
- org-modern--orig-line-spacing 'unset))
(cond
(org-modern-mode
- (when-let (width (plist-get (face-attribute 'org-modern-label :box)
:line-width))
- (set-face-attribute
- 'org-modern-label nil
- :box `(:color ,(face-attribute 'default :background nil t) :line-width
,width)))
+ (org-modern--update-label-face)
(setq
- org-modern--orig-line-spacing line-spacing
- line-spacing org-modern-line-spacing
org-modern--keywords
(append
(when-let (bullet (alist-get ?+ org-modern-list))
