| changeset 605: |
3734c596d103 |
| parent: |
74a55d5decce
|
| child: |
6fc04c4d465c |
| author: |
Richard Westhaver <ellis@rwest.io> |
| date: |
Sun, 18 Aug 2024 01:52:22 -0400 |
| permissions: |
-rw-r--r-- |
| description: |
rm babel, update org config
not sure how babel.org got back in the mix.
most notable change is alphapapa's id-from-title stuff for html exports in publish.el. |
1 ;;; lib/inbox.el --- Inbox API -*- lexical-binding: t -*- 3 ;; Copyright (C) 2023 Richard Westhaver 5 ;; Keywords: maint, tools, outlines, extensions 7 ;; This program is free software; you can redistribute it and/or modify 8 ;; it under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation, either version 3 of the License, or 10 ;; (at your option) any later version. 12 ;; This program is distributed in the hope that it will be useful, 13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;; GNU General Public License for more details. 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 22 ;; This is the elisp interface to the CC Inbox system. The main 23 ;; interface is the inbox.org file which manages personal tasks. 25 ;; Users may use `org-capture' to insert tasks and notes into their 26 ;; own `org-inbox-file' and refactor them to a more sensible 27 ;; destination with `org-refile'. 41 (defcustom org-inbox-file 42 (concat (file-name-as-directory org-directory) "inbox.org") 43 "Custom inbox file location." 47 (defcustom org-inbox-date-start-format "<%Y-%m-%d %a>" 48 "Format of DATE_START property timestamp for week headings. See 49 `org-time-stamp-formats' for accepted values." 53 (defvar org-inbox-buffer-name "*Inbox*" 54 "The name of the org-inbox buffer.") 56 (defvar org-inbox-config-buffer-name "*Inbox Config*" 57 "Then name of the org-inbox configuration buffer.") 59 (defvar org-inbox-properties 60 '("NEXT" "PREV" "FROM" "TO" "OWNER" "PROJECT" "BLOCKER")) 62 (defvar org-inbox-db-schema 63 '(id file node edge contents properties schedule)) 65 ;; `org-archive-all-done' doesn't work the way we want. This function 66 ;; will archive all done tasks in the current subtree, or the whole file 67 ;; if prefix arg is given. 68 (defun org-archive-done (&optional scope) 69 "archive all tasks with todo-state of 'DONE' or 'NOPE'." 74 (setq org-map-continue-from (org-element-property :begin (org-element-at-point)))) 77 (defun org-children-done () 78 "Mark all sub-tasks in this heading as 'DONE'." 82 (unless (= (org-current-level) 1) 86 (defun org-inbox-migrate () 87 "Migrate all sub-headings to the current week heading, archive 88 DONE tasks, and delete the empty previous week heading." 91 (cur (org-inbox-current-week-heading)) 92 ;; (prev (format-iso-week-number 93 ;; (float-time (time-subtract (current-time) (days-to-time 7))))) 95 (find-file-noselect org-inbox-file) 96 (org-find-exact-headline-in-buffer 97 (org-inbox-current-week-heading) nil t)))) 101 (org-refile nil nil (list cur org-inbox-file nil pos)) 102 (setq org-map-continue-from (org-element-property :begin (org-element-at-point))) 103 (setq pos (org-find-exact-headline-in-buffer cur nil t))) 105 (org-inbox-delete-week-heading))) 107 (defun org-inbox-week-heading-p () 108 "Check if the heading at point is an org-inbox week heading." 109 (let ((hd (org-heading-components))) 110 (when (and (eq (car hd) 1) 113 (string-match "^w[0-9][0-9]$" (nth 4 hd)) 114 (string-match "^:\\([0-9]\\)\\{4\\}:[A-Z]\\([a-z]\\)\\{2\\}:$" (nth 5 hd))) 117 (defun org-inbox-current-week-p () 118 "Check if the inbox has a heading for current week." 119 (let ((buf (find-buffer-visiting org-inbox-file))) 121 (setq buf (find-file-noselect org-inbox-file))) 123 (with-current-buffer buf 124 (goto-char (point-max)) 125 (if (re-search-backward (concat "^* " (format-iso-week-number)) nil t) t))))) 127 (defun org-inbox-delete-week-heading () 128 "Delete the week heading at point." 130 (if (not (org-inbox-week-heading-p)) 131 (if (= (org-current-level) 1) 132 (message "Failed to find a week heading at point") 133 (progn (org-up-heading-safe) 134 (org-inbox-delete-week-heading))) 135 (progn (org-mark-subtree) 136 (delete-region (region-beginning) (region-end))))) 138 (defun org-inbox-insert-week-heading () 139 "Insert a new heading for the current week. 142 SCHEDULED: <2023-01-02 Mon>--<2023-01-09 Sun> 145 (let ((buf (find-buffer-visiting org-inbox-file))) 147 (setq buf (find-file-noselect org-inbox-file))) 149 (with-current-buffer buf 150 (goto-char (point-max)) 151 (org-previous-visible-heading 1) 152 (while (> (org-outline-level) 1) 153 (outline-up-heading 1)) 154 (let* ((fmt org-inbox-date-start-format) 157 (org-timestamp-to-time 158 (org-timestamp-from-string 160 (cadr (org-element-at-point)) 163 (date-end (format-time-string fmt (last-day-of-week date-start))) 164 (title (format-iso-week-number date-start)) 165 (elt (org-element-interpret-data 167 (:title ,title :level 1 :tags (,(format-time-string "%Y:%b" date-start))) 170 (:key "DATE_START" :value ,(format-time-string fmt date-start))))))))) 171 (goto-char (point-max)) 176 (defun org-inbox-current-week-heading () 177 "Find the location of the current week heading in 178 `org-inbox-file'. Create it if it doesn't exist." 179 (if (org-inbox-current-week-p) 180 (format-iso-week-number) 181 (org-inbox-insert-week-heading))) 183 (defun org-sort-todo-priority () 184 "Sorting function used by `org-sort' to sort by todo order 185 followed by priority. Returns a pair of numbers (TODO . PRIO)." 186 (let* ((elt (cadr (org-element-at-point))) 187 (todo (substring-no-properties (plist-get elt :todo-keyword))) 188 (prio (plist-get elt :priority)) 190 (message "%s %s" todo prio) 191 (unless prio (setq prio 5)) 192 ;; FIXME todo states shouldn't be hardcoded 194 ((string= todo "GOTO") (setq res (cons 1 prio))) 195 ((string= todo "TODO") (setq res (cons 2 prio))) 196 ((string= todo "WAIT") (setq res (cons 3 prio))) 197 ((string= todo "HOLD") (setq res (cons 4 prio))) 198 ((string= todo "DONE") (setq res (cons 5 prio))) 199 ((string= todo "NOPE") (setq res (cons 6 prio)))) 200 (unless res (setq res (cons 0 prio))) 203 (defun org-sort-compare-todo-priority (a b) 204 "Given two cons consisting of (TODO . PRIO), return t if A 205 should come before B." 206 (message "a: %S b: %S" a b) 208 ((< (car a) (car b)) t) 209 ((> (car a) (car b)) nil) 212 ((< (cdr a) (cdr b)) t) 213 ((> (cdr a) (cdr b)) nil) 214 ;; nil ommitted since cond defaults to it 217 (defun org-inbox-sort () 218 "Sort the current heading by todo order followed by priority." 220 (org-sort-entries nil ?f #'org-sort-todo-priority #'org-sort-compare-todo-priority)) 222 (defun org-inbox-open () 223 "Open `org-inbox-file' or switch to its buffer if already open." 225 (if-let ((inbox (get-buffer org-inbox-buffer-name))) 226 (switch-to-buffer inbox) 227 (find-file org-inbox-file) 228 (rename-buffer org-inbox-buffer-name))) 230 (defun org-inbox-close () 231 "Close the org-inbox and associated buffers." 233 (when-let ((inbox (get-buffer org-inbox-buffer-name))) 234 (kill-buffer inbox))) 237 (defun org-dblock-write:summary ()) 239 (defun org-inbox-show-config (&optional buffer position parameters) 241 (switch-to-buffer org-inbox-config-buffer-name) 244 (widget-insert "\n\n") 245 (widget-create 'push-button 246 :notify (lambda(_widget &rest _ignore) 247 (with-current-buffer buffer 252 (propertize "Apply" 'face 'font-lock-comment-face)) 254 (widget-create 'push-button 255 :notify (lambda (_widget &rest _ignore) 257 (propertize "Cancel" 'face 'font-lock-string-face)) 258 (use-local-map widget-keymap) 261 (defun org-inbox-configure-dblock () 262 "Configure the current org-inbox-dblock at point." 264 (with-demoted-errors "Error: %S" 265 (let* ((beginning (org-beginning-of-dblock)) 266 (parameters (org-prepare-dblock))) 267 (org-inbox-show-config-buffer (current-buffer) beginning parameters)))) 270 ;; inbox.el ends here
