mirror of
https://github.com/pestctrl/emacs-config.git
synced 2026-02-16 16:24:18 +00:00
Actually commit the new code
This commit is contained in:
Benson Chu
parent
579f42156c
commit
1a257e13e6
2 changed files with 281 additions and 31 deletions
223
lisp/org-loop.el
223
lisp/org-loop.el
|
|
@ -90,5 +90,228 @@ it doesn't call `org-end-of-subtree' in that situation"
|
|||
(unless (member "ARCHIVE" ,tags)
|
||||
,@body))))))
|
||||
|
||||
(defmacro ols/children (&rest body)
|
||||
"Wraps `BODY' in a while loop that loops over direct children of a subree.
|
||||
Experimental version that takes the result of `BODY'
|
||||
and uses that to determine if the loop should iterate
|
||||
to the next position. This is to allow a more simple
|
||||
method to \"continue\", like in traditional while loops."
|
||||
(mmt-with-gensyms (end-of-subtree start result)
|
||||
`(let ((,start (progn (org-back-to-heading) (point)))
|
||||
(,end-of-subtree (ol/get-eot-marker)))
|
||||
(org-goto-first-child)
|
||||
(while (< (point) ,end-of-subtree)
|
||||
(let ((,result (progn ,@body)))
|
||||
(unless ,result
|
||||
(org-get-next-sibling)))))))
|
||||
|
||||
(defmacro olsb/children (&rest body)
|
||||
"Wraps `BODY' in a while loop that loops over all direct children of a FILE.
|
||||
Added experimental \"s\" feature, meaning that iteration will only occur if
|
||||
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 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))))
|
||||
|
||||
|
||||
(provide 'org-loop)
|
||||
;;; org-loop.el ends here
|
||||
|
|
|
|||
|
|
@ -28,10 +28,10 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl)
|
||||
(require 'org)
|
||||
(require 'org-loop)
|
||||
|
||||
|
||||
;; Utilities that will help with the rest of the code.
|
||||
|
||||
(defun get-random-uuid ()
|
||||
|
|
@ -64,7 +64,7 @@
|
|||
(progn
|
||||
(fireorg/make-fireorg-window)
|
||||
(run-with-timer 4 nil 'op/youtube-loop))
|
||||
(let ((org (find-file-noselect (op/agenda-file "refile.org"))))
|
||||
(let ((org (find-file-noselect (my/agenda-file "refile.org"))))
|
||||
(fireorg/setup org ff
|
||||
;; Goto youtube node
|
||||
(beginning-of-buffer)
|
||||
|
|
@ -89,11 +89,11 @@
|
|||
"short"
|
||||
"long"))
|
||||
(op/org-add-tag "grow")
|
||||
(op/refile-to-location (op/agenda-file "sandbox.org")
|
||||
(op/refile-to-location (my/agenda-file "sandbox.org")
|
||||
"Educational Youtube Videos"))
|
||||
(org-todo "TODO")
|
||||
(op/org-add-tag "rest")
|
||||
(op/refile-to-location (op/agenda-file "eternal.org")
|
||||
(op/refile-to-location (my/agenda-file "eternal.org")
|
||||
"Entertaining YouTube Videos")))))
|
||||
|
||||
(defun op/get-rid-of-entertaining-youtube-videos ()
|
||||
|
|
@ -103,7 +103,7 @@
|
|||
(progn
|
||||
(fireorg/make-fireorg-window)
|
||||
(run-with-timer 4 nil 'op/get-rid-of-entertaining-youtube-videos))
|
||||
(let ((org (find-file-noselect (op/agenda-file "refile.org"))))
|
||||
(let ((org (find-file-noselect (my/agenda-file "refile.org"))))
|
||||
(fireorg/setup org ff
|
||||
(beginning-of-buffer)
|
||||
(search-forward "Youtube Videos: ")
|
||||
|
|
@ -117,7 +117,7 @@
|
|||
(op/org-add-tag "watch")
|
||||
(org-todo "TODO")
|
||||
(op/org-add-tag "rest")
|
||||
(op/refile-to-location (op/agenda-file "eternal.org")
|
||||
(op/refile-to-location (my/agenda-file "eternal.org")
|
||||
"Entertaining YouTube Videos")))
|
||||
(org-get-last-sibling)))))))))
|
||||
|
||||
|
|
@ -132,40 +132,67 @@
|
|||
(goto-char point)
|
||||
(org-insert-heading)
|
||||
(insert new-heading)
|
||||
(op/org-add-tag "sorting")
|
||||
(my/org-add-tag "sorting")
|
||||
(beginning-of-line)
|
||||
(forward-char)
|
||||
(point-marker))
|
||||
(when condition
|
||||
(outline-next-heading)))))
|
||||
|
||||
;; (defun op/refile-quick-sort ()
|
||||
;; (interactive)
|
||||
;; (find-file (my/agenda-file "refile.org"))
|
||||
;; (goto-char (point-min))
|
||||
;; (outline-next-heading)
|
||||
;; (let* ((youtube-marker (op/insert-category-heading "Youtube Videos"))
|
||||
;; (reddit-marker (op/insert-category-heading "Reddit Things")))
|
||||
;; (while
|
||||
;; (progn
|
||||
;; (org-copy-subtree)
|
||||
;; (let ((tree-string (current-kill 0)))
|
||||
;; (cond ((or (string-match-p "Watch \"" tree-string)
|
||||
;; (string-match-p "youtube\.com/" tree-string)
|
||||
;; (string-match-p "youtu\.be/" tree-string))
|
||||
;; (op/refile-to-point (buffer-file-name) youtube-marker))
|
||||
;; ((or (string-match-p "reddit\.com" tree-string)
|
||||
;; (string-match-p "redd\.it" tree-string))
|
||||
;; (op/refile-to-point (buffer-file-name) reddit-marker))
|
||||
;; (t (outline-next-heading))))))))
|
||||
|
||||
(defun op/refile-quick-sort ()
|
||||
(interactive)
|
||||
(find-file (op/agenda-file "refile.org"))
|
||||
(find-file (my/agenda-file "refile.org"))
|
||||
(goto-char (point-min))
|
||||
(outline-next-heading)
|
||||
(let* ((youtube-marker (insert-category-heading "Youtube Videos"))
|
||||
(reddit-marker (insert-category-heading "Reddit Things")))
|
||||
(while
|
||||
(progn
|
||||
(org-copy-subtree)
|
||||
(let ((tree-string (current-kill 0)))
|
||||
(cond ((or (string-match-p "Watch \"" tree-string)
|
||||
(string-match-p "youtube\.com/" tree-string)
|
||||
(string-match-p "youtu\.be/" tree-string))
|
||||
(op/refile-to-point (buffer-file-name) youtube-marker))
|
||||
((or (string-match-p "reddit\.com" tree-string)
|
||||
(string-match-p "redd\.it" tree-string))
|
||||
(op/refile-to-point (buffer-file-name) reddit-marker))
|
||||
(t (outline-next-heading))))))))
|
||||
(let ((beg (ol/get-bot-marker)))
|
||||
(outline-next-heading)
|
||||
(let* ((youtube-marker (op/insert-category-heading beg "Youtube Videos"))
|
||||
(reddit-marker (op/insert-category-heading beg "Reddit Things")))
|
||||
(olsb/children
|
||||
(org-copy-subtree)
|
||||
(let ((tree-string (current-kill 0)))
|
||||
(cond ((or (string-match-p "Watch \"" tree-string)
|
||||
(string-match-p "youtube\.com/" tree-string)
|
||||
(string-match-p "youtu\.be/" tree-string))
|
||||
(op/refile-to-point (buffer-file-name) youtube-marker))
|
||||
((or (string-match-p "reddit\.com" tree-string)
|
||||
(string-match-p "redd\.it" tree-string))
|
||||
(op/refile-to-point (buffer-file-name) reddit-marker))))))))
|
||||
|
||||
(defun op/org-sort-subtree ()
|
||||
(interactive)
|
||||
(let ((db '((1-undecided . nil)))
|
||||
(beg (ol/get-bot-marker))
|
||||
(path (org-get-outline-path t)))
|
||||
(ol/children
|
||||
(when (not (member "sorting" (org-get-tags)))
|
||||
(org-set-tags (delete "sorting" (org-get-tags nil t)))
|
||||
(ols/children
|
||||
(if (member "sorting" (org-get-tags))
|
||||
(let* ((heading (org-get-heading t t t t))
|
||||
(index-of (string-match-p ":" heading))
|
||||
(category (intern (substring heading 0 index-of))))
|
||||
(forward-char)
|
||||
(setf (alist-get category db)
|
||||
(point-marker))
|
||||
nil)
|
||||
(let* ((category-name (completing-read "Category? " (mapcar #'car db)))
|
||||
(category (intern category-name))
|
||||
(entry (assoc category db)))
|
||||
|
|
@ -174,8 +201,7 @@
|
|||
(setf (alist-get category db)
|
||||
refile-location)))
|
||||
(when-let (location (alist-get category db))
|
||||
(op/refile-to-point (buffer-file-name) location)
|
||||
(org-get-last-sibling)))))))
|
||||
(op/refile-to-point (buffer-file-name) location)))))))
|
||||
|
||||
(defun fireorg/org-sort-subtree ()
|
||||
(interactive)
|
||||
|
|
@ -189,14 +215,16 @@
|
|||
(let ((db '((1-undecided . nil)))
|
||||
(beg (ol/get-bot-marker))
|
||||
(path (org-get-outline-path t)))
|
||||
(ol/children
|
||||
(org-set-tags (delete "sorting" (org-get-tags nil t)))
|
||||
(ols/children
|
||||
(if (member "sorting" (org-get-tags))
|
||||
(let* ((heading (org-get-heading t t t t))
|
||||
(index-of (string-match-p ":" heading))
|
||||
(category (intern (substring heading 0 index-of))))
|
||||
(forward-char)
|
||||
(setf (alist-get category db)
|
||||
(point-marker)))
|
||||
(point-marker))
|
||||
nil)
|
||||
(fireorg/open-link ff
|
||||
(let* ((category-name (completing-read "Category? " (mapcar #'car db)))
|
||||
(category (intern category-name))
|
||||
|
|
@ -206,8 +234,7 @@
|
|||
(setf (alist-get category db)
|
||||
refile-location)))
|
||||
(when-let (location (alist-get category db))
|
||||
(op/refile-to-point (buffer-file-name) location)
|
||||
(org-get-last-sibling)))))))))))
|
||||
(op/refile-to-point (buffer-file-name) location)))))))))))
|
||||
|
||||
;; (defun op/open-loop ()
|
||||
;; (interactive)
|
||||
|
|
|
|||
Loading…
Reference in a new issue