Last active
May 28, 2020 13:47
-
-
Save yantar92/b3ce1e265910b94e478233288636c0fd to your computer and use it in GitHub Desktop.
Fancy wrapping of headline text in agenda. Requires adaptive-wrap package.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; macros from https://github.com/weirdNox/dotfiles/blob/master/config/.emacs.d/config.org#hooks | |
(defun nox-unquote (exp) | |
"Return EXP unquoted." | |
(declare (pure t) (side-effect-free t)) | |
(while (memq (car-safe exp) '(quote function)) | |
(setq exp (cadr exp))) | |
exp) | |
(defun nox-enlist (exp) | |
"Return EXP wrapped in a list, or as-is if already a list." | |
(declare (pure t) (side-effect-free t)) | |
(if (listp exp) exp (list exp))) | |
(defun nox-resolve-hook-forms (hooks) | |
(declare (pure t) (side-effect-free t)) | |
(cl-loop with quoted-p = (eq (car-safe hooks) 'quote) | |
for hook in (nox-enlist (nox-unquote hooks)) | |
if (eq (car-safe hook) 'quote) | |
collect (cadr hook) | |
else if quoted-p | |
collect hook | |
else collect (intern (format "%s-hook" (symbol-name hook))))) | |
(defmacro add-hook! (&rest args) | |
"A convenience macro for `add-hook'. Takes, in order: | |
1. Optional properties :local and/or :append, which will make the hook | |
buffer-local or append to the list of hooks (respectively), | |
2. The hooks: either an unquoted major mode, an unquoted list of major-modes, | |
a quoted hook variable or a quoted list of hook variables. If unquoted, the | |
hooks will be resolved by appending -hook to each symbol. | |
3. A function, list of functions, or body forms to be wrapped in a lambda. | |
Examples: | |
(add-hook! 'some-mode-hook 'enable-something) (same as `add-hook') | |
(add-hook! some-mode '(enable-something and-another)) | |
(add-hook! '(one-mode-hook second-mode-hook) 'enable-something) | |
(add-hook! (one-mode second-mode) 'enable-something) | |
(add-hook! :append (one-mode second-mode) 'enable-something) | |
(add-hook! :local (one-mode second-mode) 'enable-something) | |
(add-hook! (one-mode second-mode) (setq v 5) (setq a 2)) | |
(add-hook! :append :local (one-mode second-mode) (setq v 5) (setq a 2)) | |
Body forms can access the hook's arguments through the let-bound variable `args'." | |
(declare (indent defun) (debug t)) | |
(let ((hook-fn 'add-hook) | |
append-p local-p) | |
(while (keywordp (car args)) | |
(pcase (pop args) | |
(:append (setq append-p t)) | |
(:local (setq local-p t)) | |
(:remove (setq hook-fn 'remove-hook)))) | |
(let ((hooks (nox-resolve-hook-forms (pop args))) | |
(funcs (let ((arg (car args))) | |
(if (memq (car-safe arg) '(quote function)) | |
(if (cdr-safe (cadr arg)) | |
(cadr arg) | |
(list (cadr arg))) | |
(list args)))) | |
forms) | |
(dolist (fn funcs) | |
(setq fn (if (symbolp fn) | |
`(function ,fn) | |
`(lambda (&rest _) ,@args))) | |
(dolist (hook hooks) | |
(push (if (eq hook-fn 'remove-hook) | |
`(remove-hook ',hook ,fn ,local-p) | |
`(add-hook ',hook ,fn ,append-p ,local-p)) | |
forms))) | |
`(progn ,@(if append-p (nreverse forms) forms))))) | |
(defun string-display-width (string &optional mode) | |
"Calculate diplayed column width of STRING. | |
Optional MODE specifies major mode used for display." | |
(with-temp-buffer | |
(with-silent-modifications | |
(setf (buffer-string) string)) | |
(when (fboundp mode) | |
(funcall mode) | |
(font-lock-fontify-buffer)) | |
(current-column))) | |
(defun string-display-truncate (string num &optional mode hide-p ellipsis) | |
"Trim displayed STRING to NUM columns. | |
Optional MODE specifies major mode used for display. | |
Non-nil HIDE-P means that the string should be trimmed by hiding the trailing part with text properties. | |
Optional ELLIPSIS string is shown in place of the hidden/deleted part of the string." | |
(with-temp-buffer | |
(with-silent-modifications | |
(setf (buffer-string) string)) | |
(when (fboundp mode) | |
(funcall mode) | |
(font-lock-fontify-buffer)) | |
(when (> (current-column) num) | |
(move-to-column num) | |
(with-silent-modifications | |
(if hide-p | |
(progn | |
(if (stringp ellipsis) | |
(put-text-property (point) (point-max) 'display ellipsis) | |
(put-text-property (point) (point-max) 'invisible t)) | |
(put-text-property (point) (point-max) 'truncated t)) | |
(kill-line) | |
(when (stringp ellipsis) (insert ellipsis))))) | |
(buffer-string))) | |
(defun org-agenda-fix-tag-alignment () | |
"Use 'display :align-to instead of spaces in agenda." | |
(goto-char (point-min)) | |
(setq-local word-wrap nil) ; tags would be moved to next line if `word-wrap'` is non-nil and `truncate-lines' is nil | |
(while (re-search-forward org-tag-group-re nil 'noerror) | |
(put-text-property (match-beginning 0) (match-beginning 1) 'display `(space . (:align-to (- right (,(string-display-pixel-width (match-string 1))))))))) | |
(defun org-agenda-adaptive-fill-function () | |
"Fill to the beginning of headline in agenda." | |
(save-excursion | |
(when-let ((txt (get-text-property (line-beginning-position) 'txt))) | |
(search-forward (substring txt 0 10)) | |
(goto-char (match-beginning 0)) | |
(when-let ((re (get-text-property (line-beginning-position) 'org-todo-regexp))) | |
(re-search-forward re (line-end-position) 't) | |
(re-search-forward org-priority-regexp (line-end-position) 't)) | |
(make-string (current-column) ?\ )))) | |
(defun org-agenda-truncate-headings (&rest _) | |
"Truncate agenda headings to fit the WINDOW width." | |
(with-silent-modifications | |
(save-excursion | |
;; indent wrapped lines to the position below the begining of the heading string | |
(setq-local adaptive-fill-function #'org-agenda-adaptive-fill-function) | |
;; (setq-local truncate-lines nil) | |
;; (adaptive-wrap-prefix-mode +1) | |
;; cleanup earlier truncation | |
(let ((pos (point-min)) | |
next) | |
(while (and (setq pos (next-single-char-property-change pos 'truncated nil (point-max))) | |
(setq next (next-single-char-property-change pos 'truncated nil (point-max))) | |
(get-text-property pos 'truncated)) | |
(remove-text-properties pos next '(truncated nil invisible nil display nil)))) | |
(let ((pos (point-min)) | |
next) | |
(while (and (setq pos (next-single-char-property-change pos 'org-agenda-afterline nil (point-max))) | |
(setq next (next-single-char-property-change pos 'org-agenda-afterline nil (point-max))) | |
(get-text-property pos 'org-agenda-afterline)) | |
(setf (buffer-substring pos next) ""))) | |
(goto-char (point-min)) | |
(let ((window-width (window-width)) | |
(ellipsis "…") | |
(gap " ")) | |
(while (and (setf (point) (next-single-char-property-change (point) 'org-hd-marker nil (point-max))) | |
(< (point) (point-max))) | |
(let* ((tag-width (when (re-search-forward org-tag-group-re (point-at-eol) 'noerror) | |
(string-display-width (match-string 1)))) | |
(beg (point-at-bol)) | |
(end (if tag-width (match-beginning 0) (point-at-eol))) | |
(tag-width (or tag-width 0))) | |
(setf (buffer-substring beg end) | |
(string-display-truncate (buffer-substring beg end) | |
(- window-width | |
tag-width | |
(string-display-width (s-concat ellipsis gap))) | |
nil 'hide ellipsis)) | |
(goto-char (next-single-char-property-change (point-at-bol) 'truncated nil (point-at-eol))) | |
(let ((truncated-string (buffer-substring (point) (next-single-char-property-change (point) 'truncated nil (point-at-eol))))) | |
(unless (seq-empty-p truncated-string) | |
(remove-text-properties 0 (length truncated-string) '(truncated nil invisible nil display nil) truncated-string) | |
(add-text-properties 0 (length truncated-string) '(org-agenda-afterline t) truncated-string) | |
(end-of-line) | |
(insert (apply #'propertize ellipsis | |
(text-properties-at 0 truncated-string))) | |
(insert truncated-string))) | |
(end-of-line))))))) | |
(add-hook! 'org-agenda-finalize-hook #'org-agenda-fix-tag-alignment) | |
(add-hook! :append 'org-agenda-finalize-hook #'org-agenda-truncate-headings) | |
(add-hook! 'org-agenda-finalize-hook (add-hook! :local 'window-configuration-change-hook #'org-agenda-truncate-headings)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment