emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Tyler Grinn <tylergrinn@gmail.com>
To: emacs-orgmode@gnu.org
Subject: contrib - ol-todo
Date: Fri, 16 Sep 2022 19:47:48 -0400	[thread overview]
Message-ID: <87edwax4nv.fsf@gmail.com> (raw)

[-- 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

             reply	other threads:[~2022-09-16 23:48 UTC|newest]

Thread overview: 5+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-09-16 23:47 Tyler Grinn [this message]
2022-09-20  8:20 ` contrib - ol-todo Ihor Radchenko
2022-09-22 12:46   ` Tyler Grinn
2022-09-22 14:25     ` Max Nikulin
2022-09-22 22:28       ` Tyler Grinn

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87edwax4nv.fsf@gmail.com \
    --to=tylergrinn@gmail.com \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).