mirror of
https://github.com/pestctrl/emacs-config.git
synced 2026-02-16 08:14:15 +00:00
Rewrote old code using new org-loop
Still need one function from legacy to be rewritten, involving CAT
This commit is contained in:
Benson Chu
parent
9ab5319e46
commit
699399c7b5
3 changed files with 127 additions and 223 deletions
|
|
@ -451,37 +451,28 @@
|
|||
;; Task predicates
|
||||
(defun my/no-children ()
|
||||
"Check if there are NO tasks that are TODO or DONE"
|
||||
(save-excursion
|
||||
(not (orgc-loop/todo-children has-children
|
||||
(setq has-children t)))))
|
||||
(not (ol/any-children? (org-get-todo-state))))
|
||||
|
||||
(defun my/has-children ()
|
||||
"Check if there are tasks that are TODO or DONE"
|
||||
(save-excursion
|
||||
(orgc-loop/todo-children has-children
|
||||
(setq has-children t))))
|
||||
(ol/any-children? (org-get-todo-state))))
|
||||
|
||||
(defun my/has-todo-child ()
|
||||
"Check if there are any tasks that are TODO"
|
||||
(save-excursion
|
||||
(orgc-loop/todo-children has-children
|
||||
(when (my/is-todo-task)
|
||||
(setq has-children t)))))
|
||||
(save-excursion
|
||||
(ol/any-children? (my/is-todo-task))))
|
||||
|
||||
(defun my/no-todo-children ()
|
||||
"Check if there are NO tasks that are TODO"
|
||||
(save-excursion
|
||||
(not (orgc-loop/todo-children has-children
|
||||
(when (my/is-todo-task)
|
||||
(setq has-children t))))))
|
||||
(not (ol/any-children? (my/is-todo-task)))))
|
||||
|
||||
(defun my/has-non-active-todo-child ()
|
||||
"Check if there are any tasks that are TODO"
|
||||
(save-excursion
|
||||
(orgc-loop/todo-children has-children
|
||||
(when (and (my/is-todo-task)
|
||||
(not (org-get-scheduled-time (point))))
|
||||
(setq has-children t)))))
|
||||
(ol/any-todo-children?
|
||||
(and (my/is-todo-task)
|
||||
(not (org-get-scheduled-time (point))))))
|
||||
|
||||
;; Project Stuff
|
||||
(defconst my/project-keywords '("PROJECT" "META" "META1" "SEQ" "EMPTY" "ETERNAL" "SPEC" "HOLD"))
|
||||
|
|
@ -512,10 +503,7 @@
|
|||
org-done-keywords))))
|
||||
|
||||
(defun my/has-non-done-task ()
|
||||
(save-excursion
|
||||
(orgc-loop/todo-children has-non-done-task
|
||||
(when (my/is-non-done-task)
|
||||
(setq has-non-done-task t)))))
|
||||
(ol/any-todo-children? (my/is-non-done-task)))
|
||||
|
||||
(defun my/is-a-task ()
|
||||
(save-excursion
|
||||
|
|
@ -527,10 +515,7 @@
|
|||
(my/no-children))))))
|
||||
|
||||
(defun my/has-next-task ()
|
||||
(save-excursion
|
||||
(orgc-loop/todo-children has-next-task
|
||||
(when (my/is-next-task)
|
||||
(setq has-next-task t)))))
|
||||
(ol/any-todo-children? (my/is-next-task)))
|
||||
|
||||
(defun my/is-next-task ()
|
||||
(let ((todo (org-get-todo-state)))
|
||||
|
|
@ -1935,7 +1920,7 @@
|
|||
(defun my/archive-remove-all-sibling (&rest args)
|
||||
(save-excursion
|
||||
(let (points)
|
||||
(org-loop/descendants
|
||||
(ol/descendants
|
||||
(when (my/is-archive-tree)
|
||||
(push (point) points)))
|
||||
(mapcar (lambda (p)
|
||||
|
|
|
|||
78
lisp/org-loop-legacy.el
Normal file
78
lisp/org-loop-legacy.el
Normal file
|
|
@ -0,0 +1,78 @@
|
|||
;;; org-loop-legacy.el --- -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2019Benson Chu
|
||||
|
||||
;; Author: Benson Chu <bensonchu457@gmail.com>
|
||||
;; Created: [2019-12-09 09:29]
|
||||
|
||||
;; This file is not part of GNU Emacs
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
(require 'org)
|
||||
|
||||
(defmacro orgc-loop/children-cat (condition &rest body)
|
||||
(declare (indent defun))
|
||||
(let ((level-symbol (make-symbol "level")))
|
||||
`(let ((,condition nil)
|
||||
(,level-symbol (org-current-level)))
|
||||
(outline-next-heading)
|
||||
(when (< ,level-symbol (org-current-level))
|
||||
(while (progn
|
||||
(while (string= (org-get-todo-state) "CAT")
|
||||
(outline-next-heading))
|
||||
,@body
|
||||
(and (not ,condition)
|
||||
(or (org-get-next-sibling)
|
||||
(and (not (eobp))
|
||||
(< ,level-symbol (org-current-level)))))))
|
||||
,condition))))
|
||||
|
||||
(defmacro orgc-loop/todo-children-cat (condition &rest body)
|
||||
(declare (indent defun))
|
||||
(let ((todo-state (make-symbol "todo-state"))
|
||||
(tags (make-symbol "tags")))
|
||||
`(orgc-loop/children-cat ,condition
|
||||
(let ((,todo-state (org-get-todo-state))
|
||||
(,tags (org-get-tags (point))))
|
||||
(when ,todo-state
|
||||
(if (member "ARCHIVE" ,tags)
|
||||
(org-end-of-subtree t)
|
||||
,@body))))))
|
||||
|
||||
;; (defmacro traverse-org-headlines (headline &rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((buffer-symbol (make-symbol "buffer")))
|
||||
;; `(let (,buffer-symbol)
|
||||
;; (org-check-agenda-file ,(cadr headline))
|
||||
;; (setq ,buffer-symbol (if (file-exists-p ,(cadr headline))
|
||||
;; (org-get-agenda-file-buffer ,(cadr headline))
|
||||
;; (error "No such file %s" ,(cadr headline))))
|
||||
;; (with-current-buffer ,buffer-symbol
|
||||
;; (while (and (not (eobp))
|
||||
;; (outline-next-heading))
|
||||
;; ,@body)))))
|
||||
|
||||
;; (defmacro traverse-org-files (files &rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((file-symbol (make-symbol "file")))
|
||||
;; `(dolist (,file-symbol ,(cadr files))
|
||||
;; (traverse-org-headlines (,(car files) ,file-symbol)
|
||||
;; ,@body))))
|
||||
|
||||
(provide 'org-loop-legacy)
|
||||
;;; org-loop-legacy.el ends here
|
||||
235
lisp/org-loop.el
235
lisp/org-loop.el
|
|
@ -31,6 +31,8 @@
|
|||
(require 'org)
|
||||
(require 'mmt)
|
||||
|
||||
(require 'org-loop-legacy)
|
||||
|
||||
(defun ol/get-eot-marker ()
|
||||
"Return a marker to the end of a subtree.
|
||||
This is useful for looping over a subtree while
|
||||
|
|
@ -112,206 +114,45 @@ result of `BODY' is nil"
|
|||
`(while (not (eobp))
|
||||
(unless (progn ,@body)
|
||||
(org-get-next-sibling))))
|
||||
(defun get-variables (l)
|
||||
(cond ((null l) nil)
|
||||
((consp (car l))
|
||||
(append (extract-variables (car l))
|
||||
(get-variables (cdr l))))
|
||||
(t (cons (car l)
|
||||
(get-variables (cdr l))))))
|
||||
|
||||
;; (defun extract-variables (l)
|
||||
;; (if (not (consp l))
|
||||
;; l
|
||||
;; (get-variables (cdr l))))
|
||||
(defmacro ol/any-children? (condition)
|
||||
(declare (indent defun))
|
||||
(mmt-with-gensyms (end-of-subtree start)
|
||||
`(save-excursion
|
||||
(let ((,start (progn (org-back-to-heading t) (point)))
|
||||
(,end-of-subtree (ol/get-eot-marker)))
|
||||
(while (and (if (= (point) ,start) (org-goto-first-child) (org-end-of-subtree t t))
|
||||
(< (point) ,end-of-subtree)
|
||||
(not ,condition)))
|
||||
(and (< (point) ,end-of-subtree)
|
||||
(not (= (point) ,start))
|
||||
,condition)))))
|
||||
|
||||
;; (defmacro org-loop/descendants (&rest body)
|
||||
;; (let ((subtree-symbol (make-symbol "subtree-end")))
|
||||
;; `(let ((,subtree-symbol (save-excursion (org-end-of-subtree t))))
|
||||
;; (cl-loop for p = (point)
|
||||
;; while (< p ,subtree-symbol)
|
||||
;; do (progn ,@body)))))
|
||||
|
||||
;; (defun test ()
|
||||
;; (interactive)
|
||||
;; (org-loop/descendants
|
||||
;; (message (format "%s" (org-get-todo-state)))))
|
||||
|
||||
;; ;; Descendants
|
||||
;; (defmacro org-loop/descendants (&rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((subtree-symbol (make-symbol "subtree-end")))
|
||||
;; `(let ((,subtree-symbol (save-excursion (org-end-of-subtree t))))
|
||||
;; (while (and (outline-next-heading)
|
||||
;; (< (point) ,subtree-symbol))
|
||||
;; ,@body))))
|
||||
|
||||
;; (defmacro org-loop!/descendants (&rest body)
|
||||
;; "This version of org loop will account for if the tree has been editted while looping"
|
||||
;; (declare (indent defun))
|
||||
;; ;; (let ((subtree-symbol (make-symbol "subtree-end")))
|
||||
;; ;; `(let ((,subtree-symbol (save-excursion (org-end-of-subtree t))))
|
||||
;; ;; (while (and (outline-next-heading)
|
||||
;; ;; (< (point) ,subtree-symbol))
|
||||
;; ;; ,@body)))
|
||||
;; )
|
||||
|
||||
;; (defmacro orgc-loop/descendants (condition &rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((subtree-symbol (make-symbol "subtree-end")))
|
||||
;; `(let ((,subtree-symbol (save-excursion (org-end-of-subtree t)))
|
||||
;; (,condition nil))
|
||||
;; (while (and (not ,condition)
|
||||
;; (outline-next-heading)
|
||||
;; (< (point) ,subtree-symbol))
|
||||
;; ,@body)
|
||||
;; ,condition)))
|
||||
|
||||
;; (defmacro orgb-loop/descendants (condition &rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((subtree-symbol (make-symbol "subtree-end"))
|
||||
;; (vars (extract-variables condition)))
|
||||
;; `(let ((,subtree-symbol (save-excursion (org-end-of-subtree t)))
|
||||
;; ,@vars)
|
||||
;; (while (and ,condition
|
||||
;; (outline-next-heading)
|
||||
;; (< (point) ,subtree-symbol))
|
||||
;; ,@body)
|
||||
;; ,condition)))
|
||||
|
||||
;; (defmacro orgc-loop/todo-descendants (condition &rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((todo-state (make-symbol "todo-state"))
|
||||
;; (tags (make-symbol "tags")))
|
||||
;; `(orgc-loop/descendants ,condition
|
||||
;; (let ((,todo-state (org-get-todo-state))
|
||||
;; (,tags (org-get-tags (point))))
|
||||
;; (when ,todo-state
|
||||
;; (if (member "ARCHIVE" ,tags)
|
||||
;; (org-end-of-subtree t)
|
||||
;; ,@body))))))
|
||||
|
||||
;; (defmacro org-loop/todo-children (&rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((todo-state (make-symbol "todo-state"))
|
||||
;; (tags (make-symbol "tags")))
|
||||
;; `(org-loop/children
|
||||
;; (let ((,todo-state (org-get-todo-state))
|
||||
;; (,tags (org-get-tags (point))))
|
||||
;; (when ,todo-state
|
||||
;; (if (member "ARCHIVE" ,tags)
|
||||
;; (org-end-of-subtree t)
|
||||
;; ,@body))))))
|
||||
|
||||
;; (defmacro org-loop/children (&rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((level-symbol (make-symbol "level")))
|
||||
;; `(progn
|
||||
;; (let ((,level-symbol (org-current-level)))
|
||||
;; (outline-next-heading)
|
||||
;; (when (< ,level-symbol (org-current-level))
|
||||
;; (while (progn
|
||||
;; ,@body
|
||||
;; (outline-get-next-sibling))))))))
|
||||
|
||||
;; (defmacro orgc-loop/children (condition &rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((level-symbol (make-symbol "level")))
|
||||
;; `(let ((,condition nil)
|
||||
;; (,level-symbol (org-current-level)))
|
||||
;; (outline-next-heading)
|
||||
;; (when (< ,level-symbol (org-current-level))
|
||||
;; (while (progn
|
||||
;; ,@body
|
||||
;; (and (not ,condition)
|
||||
;; (org-get-next-sibling))))
|
||||
;; ,condition))))
|
||||
|
||||
;; (defmacro orgc-loop/todo-children (condition &rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((todo-state (make-symbol "todo-state"))
|
||||
;; (tags (make-symbol "tags")))
|
||||
;; `(orgc-loop/children ,condition
|
||||
;; (let ((,todo-state (org-get-todo-state))
|
||||
;; (,tags (org-get-tags (point))))
|
||||
;; (when ,todo-state
|
||||
;; (if (member "ARCHIVE" ,tags)
|
||||
;; (org-end-of-subtree t)
|
||||
;; ,@body))))))
|
||||
|
||||
;; (defmacro orgc-loop/children-cat (condition &rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((level-symbol (make-symbol "level")))
|
||||
;; `(let ((,condition nil)
|
||||
;; (,level-symbol (org-current-level)))
|
||||
;; (outline-next-heading)
|
||||
;; (when (< ,level-symbol (org-current-level))
|
||||
;; (while (progn
|
||||
;; (while (string= (org-get-todo-state) "CAT")
|
||||
;; (outline-next-heading))
|
||||
;; ,@body
|
||||
;; (and (not ,condition)
|
||||
;; (or (org-get-next-sibling)
|
||||
;; (and (not (eobp))
|
||||
;; (< ,level-symbol (org-current-level)))))))
|
||||
;; ,condition))))
|
||||
|
||||
;; (defmacro orgc-loop/todo-children-cat (condition &rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((todo-state (make-symbol "todo-state"))
|
||||
;; (tags (make-symbol "tags")))
|
||||
;; `(orgc-loop/children-cat ,condition
|
||||
;; (let ((,todo-state (org-get-todo-state))
|
||||
;; (,tags (org-get-tags (point))))
|
||||
;; (when ,todo-state
|
||||
;; (if (member "ARCHIVE" ,tags)
|
||||
;; (org-end-of-subtree t)
|
||||
;; ,@body))))))
|
||||
|
||||
;; ;; (defmacro orgb-loop/todo-children (condition &rest body)
|
||||
;; ;; (declare (indent defun))
|
||||
;; ;; (let ((todo-state (make-symbol "todo-state"))
|
||||
;; ;; (tags (make-symbol "tags")))
|
||||
;; ;; `(orgb-loop/children ,condition
|
||||
;; ;; (let ((,todo-state (org-get-todo-state))
|
||||
;; ;; (,tags (org-get-tags (point))))
|
||||
;; ;; (when ,todo-state
|
||||
;; ;; (if (member "ARCHIVE" ,tags)
|
||||
;; ;; (org-end-of-subtree t)
|
||||
;; ;; ,@body))))))
|
||||
|
||||
;; (defmacro org-loop/todo-children (condition &rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((todo-state (make-symbol "todo-state"))
|
||||
;; (tags (make-symbol "tags")))
|
||||
;; `(org-loop/children
|
||||
;; (let ((,todo-state (org-get-todo-state))
|
||||
;; (,tags (org-get-tags (point))))
|
||||
;; (when (and ,todo-state
|
||||
;; (not (member "ARCHIVE") ,tags))
|
||||
;; ,@body)))))
|
||||
|
||||
|
||||
;; (defmacro traverse-org-headlines (headline &rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((buffer-symbol (make-symbol "buffer")))
|
||||
;; `(let (,buffer-symbol)
|
||||
;; (org-check-agenda-file ,(cadr headline))
|
||||
;; (setq ,buffer-symbol (if (file-exists-p ,(cadr headline))
|
||||
;; (org-get-agenda-file-buffer ,(cadr headline))
|
||||
;; (error "No such file %s" ,(cadr headline))))
|
||||
;; (with-current-buffer ,buffer-symbol
|
||||
;; (while (and (not (eobp))
|
||||
;; (outline-next-heading))
|
||||
;; ,@body)))))
|
||||
|
||||
;; (defmacro traverse-org-files (files &rest body)
|
||||
;; (declare (indent defun))
|
||||
;; (let ((file-symbol (make-symbol "file")))
|
||||
;; `(dolist (,file-symbol ,(cadr files))
|
||||
;; (traverse-org-headlines (,(car files) ,file-symbol)
|
||||
;; ,@body))))
|
||||
(defmacro ol/any-todo-children? (condition)
|
||||
(declare (indent defun))
|
||||
(mmt-with-gensyms (end-of-subtree start)
|
||||
`(save-excursion
|
||||
(let ((,start (progn (org-back-to-heading t) (point)))
|
||||
(,end-of-subtree (ol/get-eot-marker)))
|
||||
(while (and (if (= (point) ,start) (org-goto-first-child) (org-end-of-subtree t t))
|
||||
(< (point) ,end-of-subtree)
|
||||
(or (not (org-get-todo-state))
|
||||
(member "ARCHIVE" (org-get-tags))
|
||||
(not ,condition))))
|
||||
(and (< (point) ,end-of-subtree)
|
||||
(not (= (point) ,start))
|
||||
,condition)))))
|
||||
|
||||
(defmacro ol/any-descendents? (condition)
|
||||
(declare (indent defun))
|
||||
(mmt-with-gensyms (end-of-subtree)
|
||||
`(save-excursion
|
||||
(let ((,end-of-subtree (ol/get-eot-marker)))
|
||||
(while (and (outline-next-heading)
|
||||
(< (point) ,end-of-subtree)
|
||||
(not ,condition)))
|
||||
(and (< (point) ,end-of-subtree)
|
||||
,condition)))))
|
||||
|
||||
(provide 'org-loop)
|
||||
;;; org-loop.el ends here
|
||||
|
|
|
|||
Loading…
Reference in a new issue