org-date hack

org-date-hack.el

  (setq org-ts-regexp-both-braket "\\([[<]\\)\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]
\n>]*?\\)\\([]>]\\)")
  (defun *org-set-font-lock-defaults ()
    "Set font lock defaults for the current buffer."
    (let* ((em org-fontify-emphasized-text)
           (lk org-highlight-links)
           (org-font-lock-extra-keywords
            (list
             ;; Call the hook
             '(org-font-lock-hook)
             ;; Headlines
             `(,(if org-fontify-whole-heading-line
                    "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)"
                  "^\\(\\**\\)\\(\\* \\)\\(.*\\)")
               (1 (org-get-level-face 1))
               (2 (org-get-level-face 2))
               (3 (org-get-level-face 3)))
             ;; Table lines
             '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
               (1 'org-table t))
             ;; Table internals
             '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
             '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
             '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
             '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t))
             ;; Drawers
             '(org-fontify-drawers)
             ;; Properties
             (list org-property-re
                   '(1 'org-special-keyword t)
                   '(3 'org-property-value t))
            ;; Special keywords
             (list (concat "\\<\\(DEADLINE: \\)" org-ts-regexp-both-braket)
                   '(1 'org-deadline-custom prepend)
                   '(2 'org-deadline-custom-braket prepend)
                   '(3 'org-deadline-custom prepend)
                   '(4 'org-deadline-custom-braket prepend))
             (list (concat "\\<\\(SCHEDULED: \\)" org-ts-regexp-both-braket)
                   '(1 'org-scheduled-custom prepend)
                   '(2 'org-scheduled-custom-braket prepend)
                   '(3 'org-scheduled-custom prepend)
                   '(4 'org-scheduled-custom-braket prepend))
             (list (concat "\\<\\(CLOSED: \\)" org-ts-regexp-both-braket)
                   '(1 'org-closed-custom prepend)
                   '(2 'org-closed-custom-braket prepend)
                   '(3 'org-closed-custom prepend)
                   '(4 'org-closed-custom-braket prepend))
             (list (concat "\\<" org-clock-string) '(0 'org-special-keyword prepend))
             ;; Link related fontification.
             '(org-activate-links)
             (when (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
             (when (memq 'radio lk) '(org-activate-target-links (1 'org-link t)))
             (when (memq 'date lk) '(org-activate-dates (0 'org-date t)))
             (when (memq 'footnote lk) '(org-activate-footnote-links))
             ;; Targets.
             (list org-any-target-regexp '(0 'org-target t))
             ;; Diary sexps.
             '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
             ;; Macro
             '(org-fontify-macros)
             '(org-hide-wide-columns (0 nil append))
             ;; TODO keyword
             (list (format org-heading-keyword-regexp-format
                           org-todo-regexp)
                   '(2 (org-get-todo-face 2) t))
             ;; DONE
             (if org-fontify-done-headline
                 (list (format org-heading-keyword-regexp-format
                               (concat
                                "\\(?:"
                                (mapconcat 'regexp-quote org-done-keywords "\\|")
                                "\\)"))
                       '(2 'org-headline-done t))
               nil)
             ;; Priorities
             '(org-font-lock-add-priority-faces)
             ;; Tags
             '(org-font-lock-add-tag-faces)
             ;; Tags groups
             (when (and org-group-tags org-tag-groups-alist)
               (list (concat org-outline-regexp-bol ".+\\(:"
                             (regexp-opt (mapcar 'car org-tag-groups-alist))
                             ":\\).*$")
                     '(1 'org-tag-group prepend)))

             ;; Emphasis
             (when em '(org-do-emphasis-faces))
             ;; Checkboxes
             '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)"
               1 'org-checkbox prepend)
             (when (cdr (assq 'checkbox org-list-automatic-rules))
               '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
                 (0 (org-get-checkbox-statistics-face) t)))
             ;; Description list items
             '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)"
               1 'org-list-dt prepend)
             ;; ARCHIVEd headings
             (list (concat
                    org-outline-regexp-bol
                    "\\(.*:" org-archive-tag ":.*\\)")
                   '(1 'org-archived prepend))
             ;; Specials
             '(org-do-latex-and-related)
             '(org-fontify-entities)
             '(org-raise-scripts)
             ;; Code
             '(org-activate-code (1 'org-code t))
             ;; COMMENT
             (list (format
                    "^\\*+\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)? +\\(?9:%s\\)\\(?: \\|$\\)"
                    org-todo-regexp
                    org-comment-string)
                   '(9 'org-special-keyword t))
             ;; Blocks and meta lines
             '(org-fontify-meta-lines-and-blocks))))
      (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
      (run-hooks 'org-font-lock-set-keywords-hook)
      ;; Now set the full font-lock-keywords
      (setq-local org-font-lock-keywords org-font-lock-extra-keywords)
      (setq-local font-lock-defaults
                  '(org-font-lock-keywords t nil nil backward-paragraph))
      (kill-local-variable 'font-lock-keywords)
      nil))
  (advice-add 'org-set-font-lock-defaults :override #'*org-set-font-lock-defaults)
  (defface org-deadline-custom '((t (:inherit 'default))) "org-deadline" :group 'org)
  (defface org-scheduled-custom '((t (:inherit 'default))) "org-schedule" :group 'org)
  (defface org-closed-custom '((t (:inherit 'default))) "org-close" :group 'org)
  (defface org-deadline-custom-braket '((t (:inherit 'default))) "org-deadline" :group 'org)
  (defface org-scheduled-custom-braket '((t (:inherit 'default))) "org-schedule" :group 'org)
  (defface org-closed-custom-braket '((t (:inherit 'default))) "org-close" :group 'org)


  (defun *org-eldoc-get-timestamp (str)
    "Return timestamp if on a headline or nil."
    (if str
        (concat
         (let ((deadline (org-entry-get (point) "DEADLINE" t))
               (scheduled (org-entry-get (point) "SCHEDULED" t))
               (closed (org-entry-get (point) "CLOSED" t))
               timestamp)
           (if deadline (setq timestamp (concat timestamp (propertize (substring deadline 1 -1) 'face 'org-deadline-custom) " ")))
           (if scheduled (setq timestamp (concat timestamp (propertize (substring scheduled 1 -1) 'face 'org-scheduled-custom) " ")))
           (if closed (setq timestamp (concat timestamp (propertize (substring closed 1 -1) 'face 'org-closed-custom) " ")))
           timestamp)
         str)
      nil))

  (advice-add 'org-eldoc-get-breadcrumb :filter-return #'*org-eldoc-get-timestamp)

  (defun *org-format-outline-path-normalize (str)
    (add-face-text-property
     0 (length str)
     '(:height 1) nil str)
    str)
  (advice-add 'org-format-outline-path :filter-return #'*org-format-outline-path-normalize)