diff options
| -rw-r--r-- | emacs.d/custom/fcuny-defuns.el | 225 | ||||
| -rw-r--r-- | emacs.d/custom/fcuny-org.el | 182 |
2 files changed, 335 insertions, 72 deletions
diff --git a/emacs.d/custom/fcuny-defuns.el b/emacs.d/custom/fcuny-defuns.el index 40bd4ce..88e73a3 100644 --- a/emacs.d/custom/fcuny-defuns.el +++ b/emacs.d/custom/fcuny-defuns.el @@ -74,4 +74,229 @@ (decode-coding-string title 'utf-8)) (concat "[[" url "][" title "]]")))) +(defun fcuny/org-archive-subtree-as-completed () + "Archives the current subtree to today's current journal entry." + (interactive) + (ignore-errors + ;; According to the docs for `org-archive-subtree', the state should be + ;; automatically marked as DONE, but I don't notice that: + (when (not (equal "DONE" (org-get-todo-state))) + (org-todo "DONE"))) + + (let* ((org-archive-file (or org-default-completed-file + (fcuny/this-month-archive-entry))) + (org-archive-location (format "%s::" org-archive-file))) + (org-archive-subtree))) + +(defun fcuny/this-month-archive-entry () + "Return the full pathname to the month's archive entry file. +Granted, this assumes each journal's file entry to be formatted +with year/month, as in `201901' for January 4th. + +Note: `org-journal-dir' variable must be set to the directory +where all good journal entries live, e.g. ~/journal." + (let* ((daily-name (format "%s-archive.org" (format-time-string "%Y-%m"))) + (file-name (concat org-archive-dir daily-name))) + (expand-file-name file-name))) + +(defun fcuny/org-subtree-region () + "Return a list of the start and end of a subtree." + (save-excursion + (list (progn (org-back-to-heading) (point)) + (progn (org-end-of-subtree) (point))))) + +(defun fcuny/org-refile-directly (file-dest) + "Move the current subtree to the end of FILE-DEST. +If SHOW-AFTER is non-nil, show the destination window, +otherwise, this destination buffer is not shown." + (interactive "fDestination: ") + + (defun dump-it (file contents) + (find-file-other-window file-dest) + (goto-char (point-max)) + (insert "\n" contents)) + + (save-excursion + (let* ((region (fcuny/org-subtree-region)) + (contents (buffer-substring (first region) (second region)))) + (apply 'kill-region region) + (save-window-excursion (dump-it file-dest contents))))) + +(defun fcuny/org-refile-to-task () + "Refile (move) the current Org subtree to `org-default-tasks-file'." + (interactive) + (fcuny/org-refile-directly org-default-tasks-file)) + +(defun fcuny/org-refile-to-task () + "Refile (move) the current Org subtree to `org-default-tasks-file'." + (interactive) + (fcuny/org-refile-directly org-default-tasks-file)) + +(defun fcuny/org-refile-to-personal-notes () + "Refile (move) the current Org subtree to `org-default-notes-file'." + (interactive) + (fcuny/org-refile-directly org-default-notes-file)) + +(defun fcuny/org-refile-subtree-to-file (dir) + "Archive the org-mode subtree and create an entry in the +directory folder specified by DIR. It attempts to move as many of +the subtree's properties and other features to the new file." + (interactive "DDestination: ") + (let* ((props (fcuny/org-subtree-metadata)) + (head (plist-get props :header)) + (body (plist-get props :body)) + (tags (plist-get props :tags)) + (properties (plist-get props :properties)) + (area (plist-get props :region)) + (filename (fcuny/org-filename-from-title head)) + (filepath (format "%s/%s.org" dir filename))) + (apply #'delete-region area) + (fcuny/org-create-org-file filepath head body tags properties))) + +(defun fcuny/org-set-file-property (key value &optional spot) + "Make sure file contains a top-level, file-wide property. +KEY is something like `TITLE' or `FILETAGS'. This function makes +sure that the property contains the contents of VALUE, and if the +file doesn't have the property, it is inserted at either SPOT, or +if nil,the top of the file." + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search t)) + (if (re-search-forward (format "^#\\+%s:\s*\\(.*\\)" key) nil t) + (replace-match value nil nil nil 1) + + (cond + ;; if SPOT is a number, go to it: + ((numberp spot) (goto-char spot)) + ;; If SPOT is not given, jump to first blank line: + ((null spot) (progn (goto-char (point-min)) + (re-search-forward "^\s*$" nil t))) + (t (goto-char (point-min)))) + + (insert (format "#+%s: %s\n" (upcase key) value)))))) + +(defun fcuny/org-create-org-file (filepath header body tags properties) + "Create a new Org file by FILEPATH. The contents of the file is +pre-populated with the HEADER, BODY and any associated TAGS." + (find-file-other-window filepath) + (fcuny/org-set-file-property "TITLE" header t) + (when tags + (fcuny/org-set-file-property "FILETAGS" (s-join " " tags))) + + ;; Insert any drawer properties as #+PROPERTY entries: + (when properties + (goto-char (point-min)) + (or (re-search-forward "^\s*$" nil t) (point-max)) + (--map (insert (format "#+PROPERTY: %s %s" (first it) (second it))) properties)) + + ;; My auto-insert often adds an initial headline for a subtree, and in this + ;; case, I don't want that... Yeah, this isn't really globally applicable, + ;; but it shouldn't cause a problem for others. + (when (re-search-forward "^\\* [0-9]$" nil t) + (replace-match "")) + + (delete-blank-lines) + (goto-char (point-max)) + (insert "\n") + (insert body)) + +(defun fcuny/org-subtree-metadata () + "Return a list of key aspects of an org-subtree. Includes the +following: header text, body contents, list of tags, region list +of the start and end of the subtree." + (save-excursion + ;; Jump to the parent header if not already on a header + (when (not (org-at-heading-p)) + (org-previous-visible-heading 1)) + + (let* ((context (org-element-context)) + (attrs (second context)) + (props (org-entry-properties))) + + (list :region (list (plist-get attrs :begin) (plist-get attrs :end)) + :header (plist-get attrs :title) + :tags (fcuny/org-get-subtree-tags props) + :properties (fcuny/org-get-subtree-properties attrs) + :body (fcuny/org-get-subtree-content attrs))))) + +(defun fcuny/org-filename-from-title (title) + "Creates a useful filename based on a header string, TITLE. +For instance, given the string: What's all this then? + This function will return: whats-all-this-then" + (let* ((no-letters (rx (one-or-more (not alphanumeric)))) + (init-try (->> title + downcase + (replace-regexp-in-string "'" "") + (replace-regexp-in-string no-letters "-")))) + (string-trim init-try "-+" "-+"))) + +(defun fcuny/org-get-subtree-content (attributes) + "Return the contents of the current subtree as a string." + (let ((header-components '(clock diary-sexp drawer headline inlinetask + node-property planning property-drawer section))) + + (goto-char (plist-get attributes :contents-begin)) + + ;; Walk down past the properties, etc. + (while + (let* ((cntx (org-element-context)) + (elem (first cntx)) + (props (second cntx))) + (when (member elem header-components) + (goto-char (plist-get props :end))))) + + ;; At this point, we are at the beginning of what we consider + ;; the contents of the subtree, so we can return part of the buffer: + (buffer-substring-no-properties (point) (org-end-of-subtree)))) + +(defun fcuny/org-get-subtree-properties (attributes) + "Return a list of tuples of a subtrees properties where the keys are strings." + + (defun symbol-upcase? (sym) + (let ((case-fold-search nil)) + (string-match-p "^:[A-Z]+$" (symbol-name sym)))) + + (defun convert-tuple (tup) + (let ((key (first tup)) + (val (second tup))) + (list (substring (symbol-name key) 1) val))) + + (->> attributes + (-partition 2) ; Convert plist to list of tuples + (--filter (symbol-upcase? (first it))) ; Remove lowercase tuples + (-map 'convert-tuple))) + +(defun fcuny/org-get-subtree-tags (&optional props) + "Given the properties, PROPS, from a call to +`org-entry-properties', return a list of tags." + (unless props + (setq props (org-entry-properties))) + (let ((tag-label "ALLTAGS" )) + (-some->> props + (assoc tag-label) + cdr + substring-no-properties + (s-split ":") + (--filter (not (equalp "" it)))))) + +(defun fcuny/org-refile-to-projects-dir () + "Move the current subtree to a file in the `projects' directory." + (interactive) + (fcuny/org-refile-subtree-to-file org-default-projects-dir)) + +(defun fcuny/org-refile-to-personal-dir () + "Move the current subtree to a file in the `personal' directory." + (interactive) + (fcuny/org-refile-subtree-to-file org-default-personal-dir)) + +(defun fcuny/org-refile-to-incubate () + "Refile (move) the current Org subtree to `org-default-incubate-fire'." + (interactive) + (fcuny/org-refile-directly org-default-incubate-file)) + +(defun fcuny/org-refile-to-technical-dir () + "Move the current subtree to a file in the `technical' directory." + (interactive) + (fcuny/org-refile-subtree-to-file org-default-technical-dir)) + (provide 'fcuny-defuns) diff --git a/emacs.d/custom/fcuny-org.el b/emacs.d/custom/fcuny-org.el index 0bdac7b..9f10720 100644 --- a/emacs.d/custom/fcuny-org.el +++ b/emacs.d/custom/fcuny-org.el @@ -1,13 +1,19 @@ (require 'fcuny-vars) +(use-package dash + :ensure t) + (use-package org + :after (dash) :ensure t - :hook ((org-mode . visual-line-mode) - (org-mode . org-indent-mode)) + :hook ((org-mode . visual-line-mode) + (org-mode . org-indent-mode) + (org-capture-mode-hook . delete-other-windows)) :bind (("C-c c" . org-capture) - ("C-c a" . org-agenda)) + ("C-c a" . org-agenda) + ("C-c o" . hydra-org-menu/body)) :config (progn () @@ -18,32 +24,49 @@ (emacs-lisp . t)))) :custom - ;; priorities. I use: - ;; -1 important + urgent - ;; -2 important + non-urgent - ;; -3 non-important + urgent - ;; -4 non-important + non-urgent - (org-highest-priority ?1) - (org-default-priority ?4) - (org-lowest-priority ?4) - + ;; cosmetic (org-pretty-entities t) - (org-src-fontify-natively t) - ;; prevent the conversion of spaces into tabs (necessary for Python code exports) - (org-src-preserve-indentation t) - (org-edit-src-content-indentation t) - (org-startup-indented t) + (org-tags-column -120) + + ;; files (org-directory (expand-file-name "~/Documents/notebooks")) - (org-default-inbox-file (concat org-directory "/gtd.org")) - (org-default-notes-file (concat org-directory "/gtd.org")) + (org-archive-dir (concat org-directory "/archive/")) + + (org-default-projects-dir (concat org-directory "/projects")) + (org-default-personal-dir (concat org-directory "/personal")) + (org-default-completed-dir (concat org-directory "/completed")) + (org-default-technical-dir (concat org-directory "/technical")) + + (org-default-completed-file nil) + (org-default-inbox-file (concat org-directory "/inbox.org")) + (org-default-tasks-file (concat org-directory "/tasks.org")) + (org-default-incubate-file (concat org-directory "/incubate.org")) + (org-default-media-file (concat org-directory "/media.org")) + (org-default-notes-file (concat org-directory "/notes.org")) + + ;; how to manage tasks + (org-todo-keywords '((sequence "TODO(t)" "DOING(g)" "|" "DONE(d)") + (sequence "|" "CANCELED(c)"))) + + ;; agenda related (org-agenda-start-on-weekday 1) - (org-tags-column -120) + (org-agenda-files `(,org-default-projects-dir + ,org-default-inbox-file + ,org-default-tasks-file)) + + ;; org babel related + ;; prevent the conversion of spaces into tabs (necessary for Python code exports) + (org-src-fontify-natively t) + (org-src-preserve-indentation t) + (org-edit-src-content-indentation t) + ;; behavior ;; I want to follow links on RET (org-return-follows-link t) - (org-blank-before-new-entry (quote ((heading . nil) - (plain-list-item . nil)))) + (org-enforce-todo-dependencies t) + (org-export-with-toc nil) + (org-export-with-section-numbers nil) ;; A few abbreviations I use regularly (org-link-abbrev-alist @@ -52,62 +75,28 @@ ("ph" . "https://phabricator.twitter.biz/%s") ("go" . "http://go/%s"))) - ;; The sequence I want to use to navigate tasks - (org-todo-keywords - '((sequence "TODO(t)" "NEXT(n)" "STARTED(s)" "|" "DONE(d)" "CANCELED(c)"))) - - (org-enforce-todo-dependencies t) - - ;; list of files to use for the agenda - (org-agenda-files (list (expand-file-name "tasks.org" org-directory) - (expand-file-name "projects.org" org-directory) - (expand-file-name "tw-journal.org" org-directory))) - - (org-export-with-toc nil) - (org-export-with-section-numbers nil) + ;; entries + (org-blank-before-new-entry (quote ((heading . nil) + (plain-list-item . nil)))) ;; see https://github.com/abo-abo/swiper/issues/986 (org-goto-interface 'outline-path-completion) - (org-outline-path-complete-in-steps nil) + + ;; refile and capture (org-refile-use-outline-path 'file) + (org-outline-path-complete-in-steps nil) (org-refile-allow-creating-parent-nodes 'confirm) - (org-refile-targets '((org-agenda-files :maxlevel . 4))) - - ;; for the agenda, I want to see tasks in order of priorities. - (org-agenda-custom-commands - '(("c" "Agenda by priorities" - ((tags-todo "PRIORITY=\"1\"" - ((org-agenda-skip-function '(org-agenda-skip-entry-if 'todo 'done)) - (org-agenda-overriding-header "important and urgent:"))) - (tags-todo "PRIORITY=\"2\"" - ((org-agenda-skip-function '(org-agenda-skip-entry-if 'todo 'done)) - (org-agenda-overriding-header "important and non-urgent:"))) - (tags-todo "PRIORITY=\"3\"" - ((org-agenda-skip-function '(org-agenda-skip-entry-if 'todo 'done)) - (org-agenda-overriding-header "non-important and urgent:"))) - (agenda "" ((org-agenda-ndays 1))) - (alltodo "" ((org-agenda-skip-function '(org-agenda-skip-entry-if 'todo 'done))))) - ((org-agenda-compact-blocks t))))) + (org-refile-targets (append '((org-default-media-file :level . 1) + (org-default-notes-file :level . 0)) + (->> + (directory-files org-default-projects-dir nil ".org$") + (-remove-item (file-name-base org-default-media-file)) + (--remove (s-starts-with? "." it)) + (--map (format "%s/%s" org-default-projects-dir it)) + (--map (cons it (cons :level 1)))))) (org-capture-templates - `(;; templates for general references, links, etc. They can be relevant for both work and personal learning. - ("r" "Reference" entry - (file ,(concat org-directory "/kb.org") "Reference") - "* %^{TITLE} %^G\n:PROPERTIES:\n:Created: %U\n:END:\n%?") - ("e" "Event" entry - (file+headline ,(concat org-directory "/notes.org") "Event") - "* %^{EVENT}\n:PROPERTIES:\n:Created: %U\n:Location: %^{prompt}\n:END:\n%?") - ("b" "Bookmark" entry - (file+headline ,(concat org-directory "/notes.org") "Bookmark") - "* %(fcuny/get-page-title (current-kill 0)) %^g\n:PROPERTIES:\n:Created: %U\n:ReadLater: %^{read later|Yes|No}\n:Effort: %^{effort|1:00|0:05|0:15|0:30|2:00|4:00|5:00}\n:END:\n%?") - ("q" "Quotes" entry - (file+headline ,(concat org-directory "/notes.org") "Quote") - "* %^{TITLE}\n:PROPERTIES:\n:Created: %U\n:Page: %^{page}\n:END:\n%?") - ("d" "Debug" entry - (file ,(concat org-directory "/debug.org") "Debug") - "* %^{TITLE}\n:PROPERTIES:\n:Created: %U\n:END:\n%?") - - ;; templates for personal things only. + `(;; templates for personal things only. ("j" "Personal Journal" entry (file+olp+datetree ,(concat org-directory "/journal.org")) "* %U %?\n" @@ -133,9 +122,58 @@ ("t" "task entry" entry (file ,org-default-inbox-file ) - "* TODO [#4] %? %^G\n:PROPERTIES:\n:CREATED: %U\n:END:\n\n%i\n\nfrom: %a")))) + "* %?\n:PROPERTIES:\n:CREATED: %U\n:END:\n%i\n\nfrom: %a"))) + + :config + (defhydra hydra-org-menu (:columns 6) + " + ^Navigate^ ^Refile^ ^Move^ ^Update^ ^Go To^ ^Dired^ + ^^^^^^^^^^--------------------------------------------------------------------------------------- + _k_: ↑ previous _t_: tasks _m X_: projects _T_: todo task _g t_: tasks _g X_: projects + _j_: ↓ next _p_: personal _m P_: personal _S_: schedule _g x_: inbox _g P_: personal + _c_: archive _r_: refile _m T_: technical _D_: deadline _g n_: notes _g T_: technical + _d_: delete _i_: incubate _R_: rename _g C_: completed + " + ("<up>" org-previous-visible-heading) + ("<down>" org-next-visible-heading) + ("k" org-previous-visible-heading) + ("j" org-next-visible-heading) + ("c" fcuny/org-archive-subtree-as-completed) + ("d" org-cut-subtree) + ("t" fcuny/org-refile-to-task) + ("i" fcuny/org-refile-to-incubate) + ("p" fcuny/org-refile-to-personal-notes) + ("r" org-refile) + ("m X" fcuny/org-refile-to-projects-dir) + ("m P" fcuny/org-refile-to-personal-dir) + ("m T" fcuny/org-refile-to-technical-dir) + ("T" org-todo) + ("S" org-schedule) + ("D" org-deadline) + ("R" org-rename-header) + ("g t" (find-file-other-window org-default-tasks-file)) + ("g i" (find-file-other-window org-default-incubate-file)) + ("g x" (find-file-other-window org-default-inbox-file)) + ("g c" (find-file-other-window org-default-completed-file)) + ("g n" (find-file-other-window org-default-notes-file)) + ("g X" (dired org-default-projects-dir)) + ("g P" (dired org-default-personal-dir)) + ("g T" (dired org-default-technical-dir)) + ("g C" (dired org-default-completed-dir)) + ("[\t]" (org-cycle)) + ("s" (org-save-all-org-buffers) "save") + ("q" nil "quit"))) (use-package htmlize :ensure t) +(use-package org-journal + :ensure t + :after (org) + :custom + (org-journal-file-format "%Y-%m.org") + (org-journal-dir "~/Documents/notebooks/journal/") + (org-journal-date-format "#+TITLE: Monthly Journal Entry - %e %b %Y (%A)") + (org-journal-file-type `monthly)) + (provide 'fcuny-org) |