contrib - ol-todo

[Tyler Grinn <tylergrinn@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 882 bytes --]


I've built this small package which registers a todo type link:

[[todo:~/projects.org::#my-todo][My todo]]

And it is displayed like this:

<DONE> My todo

Where DONE is the actual todo keyword on the target heading. The keyword
on the link and target stay in sync, so setting a different todo keyword
either on the link or the target will update both. The link does not
show up in the agenda and can be placed anywhere an org link is valid.

I'm using this to create a list of todos I want done today from a larger
list of all my todos.

Is this something that would be appropriate for org-contrib?

---

When I tried to register a :store function which is valid for org buffers
backed by a file, the desired behavior was that I could choose between
storing a file link and a todo link, but instead, it simply stores a
todo link without confirmation. Is this a known problem?




[-- Attachment #2: ol-todo.el --]
[-- Type: text/plain, Size: 6400 bytes --]

;;; ol-todo.el --- Store symbolic link to a TODO entry  -*- lexical-binding: t -*-

;; Copyright (C) 2014-2022 Free Software Foundation, Inc.

;; Author: Tyler Grinn <tylergrinn@gmail.com>
;; Package-Requires: ((emacs "27.2"))
;; Version: 0.0.1

;;; Commentary:

;; When this type of link is inserted, the todo keyword of the target
;; heading is displayed before the link.  With point inside a todo
;; link, use C-c C-c to update the link and C-c C-t to change the todo
;; status of the target heading.
;;
;; Use `org-todo-link-store' to store the heading at point in
;; `org-stored-links'.  This is not registered as a provider for
;; `org-store-link' because it would override the default storing
;; behavior for org files.

;;; Code:

;;;; Requirements:

(require 'org)
(require 'ol)
(require 'org-keys)
(require 'org-refile)
(require 'org-element)

;;;; Org todo link keymap

(defun org-todo-link-recalculate ()
  "Recalculate TODO status for todo link at point."
  (interactive)
  (if-let* ((ov (seq-find
                 (lambda (o) (overlay-get o 'ol-todo))
                 (overlays-at (point))))
            (start (car (org-in-regexp org-link-any-re)))
            (link (save-excursion
                    (goto-char start)
                    (org-element-link-parser)))
            (path (org-element-property :path link)))
      (overlay-put ov 'before-string (org-todo-link-get-todo path))))

(defun org-todo-link-todo ()
  "Set TODO keyword on todo link at point."
  (interactive)
  (when-let* ((ov (seq-find
                   (lambda (o) (overlay-get o 'ol-todo))
                   (overlays-at (point))))
              (start (car (org-in-regexp org-link-any-re)))
              (link (save-excursion
                      (goto-char start)
                      (org-element-link-parser)))
              (path (org-element-property :path link)))
    (save-window-excursion
      (let* ((org-link-frame-setup '((file . find-file)))
             (pos (org-todo-link-find path)))
        (save-excursion
          (goto-char pos)
          (org-todo))))
    (overlay-put ov 'before-string (org-todo-link-get-todo path))))

(defvar org-todo-link-keymap
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map org-mouse-map)
    (mapc
     (lambda (k) (define-key map (kbd (car k)) (cdr k)))
     '(("C-c C-c" . org-todo-link-recalculate)
       ("C-c C-t" . org-todo-link-todo)))
    map)
  "Keymap for todo links.")

;; Create `todo' style link
;;;###autoload
(org-link-set-parameters "todo"
                         :complete #'org-todo-link-complete
                         :insert-description #'org-todo-link-description
                         :activate-func #'org-todo-link-activate
                         :face #'org-todo-link-face
                         :follow #'org-todo-link-follow
                         :keymap org-todo-link-keymap)

(defun org-todo-link-complete (&optional _)
  "Prompt user to complete path to TODO item in refile targets."
  (let ((it (org-refile-get-location "TODO Item: "))
        (org-link-frame-setup '((file . find-file)))
        org-stored-links)
    (save-window-excursion
      (org-open-file (nth 1 it))
      (save-excursion
        (goto-char (nth 3 it))
        (org-todo-link-store)))
    (caar org-stored-links)))

(defun org-todo-link-description (loc _)
  "Generate probable description from todo link LOC."
  (save-window-excursion
    (let* ((org-link-frame-setup '((file . find-file)))
           (pos (org-todo-link-find
                 (replace-regexp-in-string "^todo:" "" loc))))
      (org-entry-get pos "ITEM"))))

(defun org-todo-link-activate (start end path &rest _)
  "Create overlay from START to END and display todo of heading at PATH."
  (let ((overlays (seq-filter
                   (lambda (o) (overlay-get o 'ol-todo))
                   (overlays-in start end))))
    (if (not overlays)
        (let ((ov (make-overlay start end)))
          (overlay-put ov 'ol-todo t)
          (overlay-put ov 'evaporate t)
          (overlay-put ov 'before-string (org-todo-link-get-todo path)))
      (move-overlay (car overlays) start end)
      (overlay-put (car overlays) 'before-string (org-todo-link-get-todo path))
      (mapc #'delete-overlay (cdr overlays)))))

(defun org-todo-link-face (path)
  "Calculate TODO status for link at point with PATH."
  (if-let ((ov (seq-find
                (lambda (o) (overlay-get o 'ol-todo))
                (overlays-at (1- (point))))))
      (overlay-put ov 'before-string (org-todo-link-get-todo path)))
  'org-link)

(defun org-todo-link-follow (path _)
  "Open a todo link to PATH."
  (goto-char (org-todo-link-find path)))

;;;; Commands

;;;###autoload
(defun org-todo-link-store ()
  "Store a todo link to the current heading."
  (interactive)
  (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
    (let (link)
      (let (org-stored-links)
        (org-store-link '(16) t)
        (setq link (car org-stored-links)))
      (when link
        (setcar link (replace-regexp-in-string "^file:" "todo:" (car link)))
        (push link org-stored-links)))))

;;;; Utility Expressions

(defun org-todo-link-find (path)
  "Jump to file part of PATH and return the heading position."
  (let ((link (with-temp-buffer
                (insert "[[file:" path "]]")
                (goto-char (point-min))
                (org-element-link-parser)))
        (org-link-search-must-match-exact-headline t))
    (org-open-file (org-element-property :path link))
    (org-with-wide-buffer
     (org-link-search (org-element-property :search-option link))
     (point))))

(defun org-todo-link-get-todo (path)
  "Get TODO keyword at PATH."
  (save-window-excursion
    (let* (broken
           (org-link-frame-setup '((file . find-file)))
           (todo (condition-case err
                    (org-entry-get (org-todo-link-find path) "TODO")
                   (error
                    (message (error-message-string err))
                    (setq broken t)))))
      (concat "<"
              (cond
               (broken "BROKEN")
               (todo 
                (propertize todo 'face (if (member todo org-done-keywords)
                                           'org-done
                                         'org-todo)))
               (t "NONE"))
              "> "))))

(provide 'ol-todo)

;;; ol-todo.el ends here