emacs-config/my-redefs.org

• Scan Tags Indent
• org-timeline at beginning of agenda buffer
• org-caldav bug

Scan Tags Indent

  (defun get-parent-indent-level ()
    (save-excursion
      (let ((levels 0))
        (while (and (org-up-heading-safe)
                    (org-get-todo-state))
          (incf levels))
        levels)))

  (defun org-scan-tags (action matcher todo-only &optional start-level)
    "Scan headline tags with inheritance and produce output ACTION.

    ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
    or `agenda' to produce an entry list for an agenda view.  It can also be
    a Lisp form or a function that should be called at each matched headline, in
    this case the return value is a list of all return values from these calls.

    MATCHER is a function accepting three arguments, returning
    a non-nil value whenever a given set of tags qualifies a headline
    for inclusion.  See `org-make-tags-matcher' for more information.
    As a special case, it can also be set to t (respectively nil) in
    order to match all (respectively none) headline.

    When TODO-ONLY is non-nil, only lines with a TODO keyword are
    included in the output.

    START-LEVEL can be a string with asterisks, reducing the scope to
    headlines matching this string."
    (require 'org-agenda)
    (let* ((re (concat "^"
                       (if start-level
                           ;; Get the correct level to match
                           (concat "\\*\\{" (number-to-string start-level) "\\} ")
                         org-outline-regexp)
                       " *\\(\\<\\("
                       (mapconcat #'regexp-quote org-todo-keywords-1 "\\|")
                       "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
           (props (list 'face 'default
                        'done-face 'org-agenda-done
                        'undone-face 'default
                        'mouse-face 'highlight
                        'org-not-done-regexp org-not-done-regexp
                        'org-todo-regexp org-todo-regexp
                        'org-complex-heading-regexp org-complex-heading-regexp
                        'help-echo
                        (format "mouse-2 or RET jump to Org file %S"
                                (abbreviate-file-name
                                 (or (buffer-file-name (buffer-base-buffer))
                                     (buffer-name (buffer-base-buffer)))))))
           (org-map-continue-from nil)
           lspos tags tags-list
           (tags-alist (list (cons 0 org-file-tags)))
           (llast 0) rtn rtn1 level category i txt
           todo marker entry priority
           ts-date ts-date-type ts-date-pair)
      (unless (or (member action '(agenda sparse-tree)) (functionp action))
        (setq action (list 'lambda nil action)))
      (save-excursion
        (goto-char (point-min))
        (when (eq action 'sparse-tree)
          (org-overview)
          (org-remove-occur-highlights))
        (while (let (case-fold-search)
                 (re-search-forward re nil t))
          (setq org-map-continue-from nil)
          (catch :skip
            ;; Ignore closing parts of inline tasks.
            (when (and (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p))
              (throw :skip t))
            (setq todo
                  ;; TODO: is the 1-2 difference a bug?
                  (when (match-end 1) (match-string-no-properties 2))
                  tags (when (match-end 4) (match-string-no-properties 4)))
            (goto-char (setq lspos (match-beginning 0)))
            (setq level (org-reduced-level (org-outline-level))
                  category (org-get-category))
            (when (eq action 'agenda)
              (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
                    ts-date (car ts-date-pair)
                    ts-date-type (cdr ts-date-pair)))
            (setq i llast llast level)
            ;; remove tag lists from same and sublevels
            (while (>= i level)
              (when (setq entry (assoc i tags-alist))
                (setq tags-alist (delete entry tags-alist)))
              (setq i (1- i)))
            ;; add the next tags
            (when tags
              (setq tags (org-split-string tags ":")
                    tags-alist
                    (cons (cons level tags) tags-alist)))
            ;; compile tags for current headline
            (setq tags-list
                  (if org-use-tag-inheritance
                      (apply 'append (mapcar 'cdr (reverse tags-alist)))
                    tags)
                  org-scanner-tags tags-list)
            (when org-use-tag-inheritance
              (setcdr (car tags-alist)
                      (mapcar (lambda (x)
                                (setq x (copy-sequence x))
                                (org-add-prop-inherited x))
                              (cdar tags-alist))))
            (when (and tags org-use-tag-inheritance
                       (or (not (eq t org-use-tag-inheritance))
                           org-tags-exclude-from-inheritance))
              ;; Selective inheritance, remove uninherited ones.
              (setcdr (car tags-alist)
                      (org-remove-uninherited-tags (cdar tags-alist))))
            (when (and

                   ;; eval matcher only when the todo condition is OK
                   (and (or (not todo-only) (member todo org-todo-keywords-1))
                        (if (functionp matcher)
                            (let ((case-fold-search t) (org-trust-scanner-tags t))
                              (funcall matcher todo tags-list level))
                          matcher))

                   ;; Call the skipper, but return t if it does not
                   ;; skip, so that the `and' form continues evaluating.
                   (progn
                     (unless (eq action 'sparse-tree) (org-agenda-skip))
                     t)

                   ;; Check if timestamps are deselecting this entry
                   (or (not todo-only)
                       (and (member todo org-todo-keywords-1)
                            (or (not org-agenda-tags-todo-honor-ignore-options)
                                (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))

              ;; select this headline
              (cond
               ((eq action 'sparse-tree)
                (and org-highlight-sparse-tree-matches
                     (org-get-heading) (match-end 0)
                     (org-highlight-new-match
                      (match-beginning 1) (match-end 1)))
                (org-show-context 'tags-tree))
               ((eq action 'agenda)
                (setq txt (org-agenda-format-item
                           ""
                           (concat
                            (if (eq org-tags-match-list-sublevels 'indented)
                                (make-string (get-parent-indent-level) ?.) "")
                            (org-get-heading))
                           (make-string level ?\s)
                           category
                           tags-list)
                      priority (org-get-priority txt))
                (goto-char lspos)
                (setq marker (org-agenda-new-marker))
                (org-add-props txt props
                  'org-marker marker 'org-hd-marker marker 'org-category category
                  'todo-state todo
                  'ts-date ts-date
                  'priority priority
                  'type (concat "tagsmatch" ts-date-type))
                (push txt rtn))
               ((functionp action)
                (setq org-map-continue-from nil)
                (save-excursion
                  (setq rtn1 (funcall action))
                  (push rtn1 rtn)))
               (t (user-error "Invalid action")))

              ;; if we are to skip sublevels, jump to end of subtree
              (unless org-tags-match-list-sublevels
                (org-end-of-subtree t)
                (backward-char 1))))
          ;; Get the correct position from where to continue
          (if org-map-continue-from
              (goto-char org-map-continue-from)
            (and (= (point) lspos) (end-of-line 1)))))
      (when (and (eq action 'sparse-tree)
                 (not org-sparse-tree-open-archived-trees))
        (org-hide-archived-subtrees (point-min) (point-max)))
      (nreverse rtn)))

org-timeline at beginning of agenda buffer

  (defun org-timeline-insert-timeline ()
    "Insert graphical timeline into agenda buffer."
    (unless (buffer-narrowed-p)
      (goto-char (point-min))
      (while (and (not (eq (get-text-property (line-beginning-position) 'org-agenda-type) 'agenda))
                  (not (eobp)))
        (forward-line))
      (forward-line)
      (unless (eobp)
        (let ((inhibit-read-only t))
          (insert (org-timeline--generate-timeline))
          (insert (propertize (concat "\n" (make-string (/ (window-width) 2) ?─)) 'face 'org-time-grid) "\n"))
        ;; enable `font-lock-mode' in agenda view to display the "chart"
        (font-lock-mode))))

org-caldav bug

    (defun org-caldav-skip-function (backend)
      (when (eq backend 'icalendar)
        (org-map-entries
         (lambda ()
           (let ((pt (save-excursion (apply 'org-agenda-skip-entry-if org-caldav-skip-conditions))))
             (when pt
               (org-todo 'none)
               (let ((current-prefix-arg '(4))) 
                 (call-interactively 'org-schedule)
                 (call-interactively 'org-deadline))))))))