Commit tangled versions of my website code
This makes this project self-contained for others to steal.
This commit is contained in:
Howard Abrams
parent
2dcac6e761
commit
2380d70508
4 changed files with 622 additions and 0 deletions
107
elisp/beep.el
Normal file
107
elisp/beep.el
Normal file
|
|
@ -0,0 +1,107 @@
|
||||||
|
;;; beep.el --- A literate programming for alerting after long projects. -*- lexical-binding: t; -*-
|
||||||
|
;;
|
||||||
|
;; Copyright (C) 2020 Howard X. Abrams
|
||||||
|
;;
|
||||||
|
;; Author: Howard X. Abrams <http://gitlab.com/howardabrams>
|
||||||
|
;; Maintainer: Howard X. Abrams <howard.abrams@gmail.com>
|
||||||
|
;; Created: December 23, 2020
|
||||||
|
;;
|
||||||
|
;; This file is not part of GNU Emacs.
|
||||||
|
;;
|
||||||
|
;; *NB:* Do not edit this file. Instead, edit the original literate file at:
|
||||||
|
;; ~/website/Technical/Emacs/beep-for-emacs.org
|
||||||
|
;; And tangle the file to recreate this one.
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(defvar beep-alert-sound-file
|
||||||
|
(expand-file-name "~/other/hamacs/beep-notify.wav")
|
||||||
|
"A WAV or AU file used at the completion of a function.")
|
||||||
|
|
||||||
|
;; My replacement in case we can't play internal sounds:
|
||||||
|
(defun beep--beep ()
|
||||||
|
"Play a default notification sound file.
|
||||||
|
Customize the variable, `beep-alert-sound-file' to adjust the sound."
|
||||||
|
(if (fboundp 'play-sound-internal)
|
||||||
|
(play-sound-file beep-alert-sound-file)
|
||||||
|
(call-process-shell-command (format "afplay %s &" beep-alert-sound-file) nil 0)))
|
||||||
|
|
||||||
|
(defvar beep-speech-executable "say %s"
|
||||||
|
"An OS-dependent shell string to speak. Replaces `%s' with a phrase.")
|
||||||
|
|
||||||
|
(defun beep--speak (phrase)
|
||||||
|
"Call a program to speak the string, PHRASE.
|
||||||
|
Customize the variable, `beep-speech-executable'."
|
||||||
|
(let ((command (format beep-speech-executable phrase)))
|
||||||
|
(shell-command command)))
|
||||||
|
|
||||||
|
(defun beep--when-finished (phrase)
|
||||||
|
"Notify us with string, PHRASE, to grab our attention.
|
||||||
|
Useful after a long process has completed, but use sparingly,
|
||||||
|
as this can be pretty distracting."
|
||||||
|
(message phrase)
|
||||||
|
(when (functionp 'alert)
|
||||||
|
(alert phrase :title "Completed"))
|
||||||
|
(beep--beep)
|
||||||
|
(beep--speak phrase))
|
||||||
|
|
||||||
|
(defun compile-and-notify ()
|
||||||
|
"Call `counsel-compile' and notify us when finished.
|
||||||
|
See `beep--when-finished' for details."
|
||||||
|
(interactive)
|
||||||
|
(let ((root (projectile-project-root)))
|
||||||
|
(counsel-compile root)
|
||||||
|
(beep--when-finished "The compile command has finished.")))
|
||||||
|
|
||||||
|
(defvar beep-func-too-long-time 5
|
||||||
|
"The number of seconds a function runs before it is considered taking too much time, and needing to be alerted when it has finished.")
|
||||||
|
|
||||||
|
(defun beep--after-function (func)
|
||||||
|
"Call the function, FUNC, interactively, and notify us when completed."
|
||||||
|
(let ((start-time (current-time))
|
||||||
|
duration)
|
||||||
|
(call-interactively func)
|
||||||
|
(setq duration (thread-first
|
||||||
|
(current-time)
|
||||||
|
(time-subtract start-time)
|
||||||
|
decode-time
|
||||||
|
first))
|
||||||
|
(when (> duration beep-func-too-long-time)
|
||||||
|
(beep--when-finished (format "The function, %s, has finished." func)))))
|
||||||
|
|
||||||
|
(defun recompile-and-notify ()
|
||||||
|
"Call `recompile' and notify us when finished.
|
||||||
|
See `beep--when-finished' for details."
|
||||||
|
(interactive)
|
||||||
|
(beep--after-function 'recompile))
|
||||||
|
|
||||||
|
(global-set-key (kbd "C-c c") 'recompile-and-notify)
|
||||||
|
(global-set-key (kbd "C-c C") 'compile-and-notify)
|
||||||
|
|
||||||
|
(defun beep-when-runs-too-long (orig-function &rest args)
|
||||||
|
"Notifies us about the completion of ORIG-FUNCTION.
|
||||||
|
Useful as after advice to long-running functions, for instance:
|
||||||
|
|
||||||
|
(advice-add 'org-publish :around #'beep-when-runs-too-long)"
|
||||||
|
(let ((start-time (current-time))
|
||||||
|
duration)
|
||||||
|
(apply orig-function args)
|
||||||
|
(setq duration (thread-first
|
||||||
|
(current-time)
|
||||||
|
(time-subtract start-time)
|
||||||
|
decode-time
|
||||||
|
first))
|
||||||
|
(when (> duration beep-func-too-long-time)
|
||||||
|
(beep--when-finished (format "The function, %s, has finished."
|
||||||
|
(beep--extract-function-name orig-function))))))
|
||||||
|
|
||||||
|
(defun beep--extract-function-name (expr)
|
||||||
|
"Extracts the original function from a lambda expression, EXPR."
|
||||||
|
(if (listp expr)
|
||||||
|
(if (equal (car expr) 'lambda)
|
||||||
|
(car (cadr expr))
|
||||||
|
expr)
|
||||||
|
expr))
|
||||||
|
|
||||||
|
(provide 'beep)
|
||||||
|
;;; beep.el ends here
|
||||||
203
elisp/boxes-extras.el
Normal file
203
elisp/boxes-extras.el
Normal file
|
|
@ -0,0 +1,203 @@
|
||||||
|
;;; BOXES-EXTRAS --- Refiling Subtrees to Proper Org Files
|
||||||
|
;;
|
||||||
|
;; Author: Howard Abrams <howard@howardabrams.com>
|
||||||
|
;; Copyright © 2019, Howard Abrams, all rights reserved.
|
||||||
|
;; Created: 7 January 2019
|
||||||
|
;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
;; WARNING: This file is tangled from its original essay.
|
||||||
|
;;
|
||||||
|
;; For a thorough explanation of this code, see the online essay:
|
||||||
|
;; http://www.howardism.org/Technical/Emacs/getting-even-more-boxes-done.html
|
||||||
|
;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;
|
||||||
|
;; 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, 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; see the file COPYING. If not, write to
|
||||||
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||||||
|
;; Floor, Boston, MA 02110-1301, USA.
|
||||||
|
;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(defun 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 (org-get-subtree-tags props)
|
||||||
|
:properties (org-get-subtree-properties attrs)
|
||||||
|
:body (org-get-subtree-content attrs)))))
|
||||||
|
|
||||||
|
(defun 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 (if org-get-subtree-tags-inherited "ALLTAGS" "TAGS")))
|
||||||
|
(-some->> props
|
||||||
|
(assoc tag-label)
|
||||||
|
cdr
|
||||||
|
substring-no-properties
|
||||||
|
(s-split ":")
|
||||||
|
(--filter (not (equalp "" it))))))
|
||||||
|
|
||||||
|
(defvar org-get-subtree-tags-inherited t
|
||||||
|
"Returns a subtree's tags, and all tags inherited (from tags
|
||||||
|
specified in parents headlines or on the file itself). Defaults
|
||||||
|
to true.")
|
||||||
|
|
||||||
|
(defun 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 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 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 (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 (org-filename-from-title head))
|
||||||
|
(filepath (format "%s/%s.org" dir filename)))
|
||||||
|
(apply #'delete-region area)
|
||||||
|
(org-create-org-file filepath head body tags properties)))
|
||||||
|
|
||||||
|
(defun 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)
|
||||||
|
(org-set-file-property "TITLE" header t)
|
||||||
|
(when tags
|
||||||
|
(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 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 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 org-refile-to-projects-dir ()
|
||||||
|
"Move the current subtree to a file in the `projects' directory."
|
||||||
|
(interactive)
|
||||||
|
(org-refile-subtree-to-file org-default-projects-dir))
|
||||||
|
|
||||||
|
(defun org-refile-to-technical-dir ()
|
||||||
|
"Move the current subtree to a file in the `technical' directory."
|
||||||
|
(interactive)
|
||||||
|
(org-refile-subtree-to-file org-default-technical-dir))
|
||||||
|
|
||||||
|
(define-auto-insert "/personal/*\\.org" ["personal.org" ha/autoinsert-yas-expand])
|
||||||
|
|
||||||
|
(defun org-refile-to-personal-dir ()
|
||||||
|
"Move the current subtree to a file in the `personal' directory."
|
||||||
|
(interactive)
|
||||||
|
(org-refile-subtree-to-file org-default-personal-dir))
|
||||||
|
|
||||||
|
(provide 'boxes-extras)
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;; boxes-extras.el ends here
|
||||||
238
elisp/boxes.el
Normal file
238
elisp/boxes.el
Normal file
|
|
@ -0,0 +1,238 @@
|
||||||
|
;;; BOXES --- An opinionated approach to a GTD workflow
|
||||||
|
;;
|
||||||
|
;; Author: Howard Abrams <howard@howardabrams.com>
|
||||||
|
;; Copyright © 2019, Howard Abrams, all rights reserved.
|
||||||
|
;; Created: 7 January 2019
|
||||||
|
;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
;; WARNING: This file is tangled from its original essay.
|
||||||
|
;;
|
||||||
|
;; For a thorough explanation of this code, see the online essay:
|
||||||
|
;; http://www.howardism.org/Technical/Emacs/getting-more-boxes-done.html
|
||||||
|
;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;
|
||||||
|
;; 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, 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; see the file COPYING. If not, write to
|
||||||
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||||||
|
;; Floor, Boston, MA 02110-1301, USA.
|
||||||
|
;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(defvar org-default-projects-dir "~/projects" "Primary GTD directory")
|
||||||
|
(defvar org-default-technical-dir "~/technical" "Directory of shareable notes")
|
||||||
|
(defvar org-default-personal-dir "~/personal" "Directory of un-shareable, personal notes")
|
||||||
|
(defvar org-default-completed-dir "~/projects/trophies" "Directory of completed project files")
|
||||||
|
(defvar org-default-inbox-file "~/projects/breathe.org" "New stuff collects in this file")
|
||||||
|
(defvar org-default-tasks-file "~/projects/tasks.org" "Tasks, TODOs and little projects")
|
||||||
|
(defvar org-default-incubate-file "~/projects/incubate.org" "Ideas simmering on back burner")
|
||||||
|
(defvar org-default-completed-file nil "Ideas simmering on back burner")
|
||||||
|
(defvar org-default-notes-file "~/personal/general-notes.org" "Non-actionable, personal notes")
|
||||||
|
(defvar org-default-media-file "~/projects/media.org" "White papers and links to other things to check out")
|
||||||
|
|
||||||
|
(defvar org-capture-templates (list))
|
||||||
|
|
||||||
|
(add-to-list 'org-capture-templates
|
||||||
|
`("t" "Task Entry" entry
|
||||||
|
(file ,org-default-inbox-file)
|
||||||
|
"* %?\n:PROPERTIES:\n:CREATED:%U\n:END:\n\n%i\n\nFrom: %a"
|
||||||
|
:empty-lines 1))
|
||||||
|
|
||||||
|
(defhydra hydra-org-refiler (org-mode-map "C-c s" :hint nil)
|
||||||
|
"
|
||||||
|
^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 _i_/_I_: incubate _m P_: personal _S_: schedule _g i_: incubate _g P_: personal
|
||||||
|
_c_: archive _p_: personal _m T_: technical _D_: deadline _g x_: inbox _g T_: technical
|
||||||
|
_d_: delete _r_: refile _R_: rename _g n_: notes _g C_: completed
|
||||||
|
"
|
||||||
|
("<up>" org-previous-visible-heading)
|
||||||
|
("<down>" org-next-visible-heading)
|
||||||
|
("k" org-previous-visible-heading)
|
||||||
|
("j" org-next-visible-heading)
|
||||||
|
("c" org-archive-subtree-as-completed)
|
||||||
|
("d" org-cut-subtree)
|
||||||
|
("t" org-refile-to-task)
|
||||||
|
("i" org-refile-to-incubate)
|
||||||
|
("I" org-refile-to-another-incubator)
|
||||||
|
("p" org-refile-to-personal-notes)
|
||||||
|
("r" org-refile)
|
||||||
|
("m X" org-refile-to-projects-dir)
|
||||||
|
("m P" org-refile-to-personal-dir)
|
||||||
|
("m T" 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")
|
||||||
|
("<tab>" (org-cycle) "toggle")
|
||||||
|
("q" nil "quit"))
|
||||||
|
|
||||||
|
(setq org-refile-use-outline-path 'file
|
||||||
|
org-refile-allow-creating-parent-nodes t
|
||||||
|
org-outline-path-complete-in-steps nil)
|
||||||
|
|
||||||
|
(setq org-refile-targets
|
||||||
|
(append `((,(expand-file-name org-default-media-file) :level . 1)
|
||||||
|
(,(expand-file-name 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))
|
||||||
|
(--remove (s-ends-with? "_archive" it))
|
||||||
|
(--map (format "%s/%s" (expand-file-name org-default-projects-dir) it))
|
||||||
|
(--map `(,it :level . 0)))))
|
||||||
|
|
||||||
|
(setq org-refile-target-table nil)
|
||||||
|
|
||||||
|
(defun 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 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 (org-subtree-region))
|
||||||
|
(contents (buffer-substring (first region) (second region))))
|
||||||
|
(apply 'kill-region region)
|
||||||
|
(if org-refile-directly-show-after
|
||||||
|
(save-current-buffer (dump-it file-dest contents))
|
||||||
|
(save-window-excursion (dump-it file-dest contents))))))
|
||||||
|
|
||||||
|
(defvar org-refile-directly-show-after nil
|
||||||
|
"When refiling directly (using the `org-refile-directly'
|
||||||
|
function), show the destination buffer afterwards if this is set
|
||||||
|
to `t', otherwise, just do everything in the background.")
|
||||||
|
|
||||||
|
(defun org-refile-to-incubate ()
|
||||||
|
"Refile (move) the current Org subtree to `org-default-incubate-fire'."
|
||||||
|
(interactive)
|
||||||
|
(org-refile-directly org-default-incubate-file))
|
||||||
|
|
||||||
|
(defun org-refile-to-task ()
|
||||||
|
"Refile (move) the current Org subtree to `org-default-tasks-file'."
|
||||||
|
(interactive)
|
||||||
|
(org-refile-directly org-default-tasks-file))
|
||||||
|
|
||||||
|
(defun org-refile-to-personal-notes ()
|
||||||
|
"Refile (move) the current Org subtree to `org-default-notes-file'."
|
||||||
|
(interactive)
|
||||||
|
(org-refile-directly org-default-notes-file))
|
||||||
|
|
||||||
|
(defun org-refile-to-completed ()
|
||||||
|
"Refile (move) the current Org subtree to `org-default-completed-file',
|
||||||
|
unless it doesn't exist, in which case, refile to today's journal entry."
|
||||||
|
(interactive)
|
||||||
|
(if (and org-default-completed-file (file-exists-p org-default-completed-file))
|
||||||
|
(org-refile-directly org-default-completed-file)
|
||||||
|
(org-refile-directly (get-journal-file-today))))
|
||||||
|
|
||||||
|
(defun org-rename-header (label)
|
||||||
|
"Rename the current section's header to LABEL, and moves the
|
||||||
|
point to the end of the line."
|
||||||
|
(interactive (list
|
||||||
|
(read-string "Header: "
|
||||||
|
(substring-no-properties (org-get-heading t t t t)))))
|
||||||
|
(org-back-to-heading)
|
||||||
|
(replace-string (org-get-heading t t t t) label))
|
||||||
|
|
||||||
|
(defun org-archive-subtree-as-completed ()
|
||||||
|
"Archives the current subtree to today's current journal entry."
|
||||||
|
(interactive)
|
||||||
|
;; According to the docs for `org-archive-subtree', the state should be
|
||||||
|
;; automatically marked as DONE, but I don't notice it, so let's force:
|
||||||
|
(when (not (equal "DONE" (org-get-todo-state)))
|
||||||
|
(org-todo "DONE"))
|
||||||
|
|
||||||
|
(let* ((org-archive-file (or org-default-completed-file
|
||||||
|
(todays-journal-entry)))
|
||||||
|
(org-archive-location (format "%s::" org-archive-file)))
|
||||||
|
(org-archive-subtree)))
|
||||||
|
|
||||||
|
(defun todays-journal-entry ()
|
||||||
|
"Return the full pathname to the day's journal entry file.
|
||||||
|
Granted, this assumes each journal's file entry to be formatted
|
||||||
|
with year/month/day, as in `20190104' 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-time-string "%Y%m%d"))
|
||||||
|
(file-name (concat org-journal-dir daily-name)))
|
||||||
|
(expand-file-name file-name)))
|
||||||
|
|
||||||
|
;; Attempt to load the extra library functions tangled from a different essay:
|
||||||
|
(condition-case nil
|
||||||
|
(load-library "boxes-extras")
|
||||||
|
(error
|
||||||
|
(defun org-refile-to-projects-dir ()
|
||||||
|
(interactive)
|
||||||
|
(message "Need to load the 'boxes-extra project first."))
|
||||||
|
(defun org-refile-to-personal-dir ()
|
||||||
|
(interactive)
|
||||||
|
(message "Need to load the 'boxes-extra project first."))
|
||||||
|
(defun org-refile-to-technical-dir ()
|
||||||
|
(interactive)
|
||||||
|
(message "Need to load the 'boxes-extra project first."))))
|
||||||
|
|
||||||
|
(defun org-boxes-workflow ()
|
||||||
|
"Load the default tasks file and start our hydra on the first task shown."
|
||||||
|
(interactive)
|
||||||
|
(let ((org-startup-folded nil))
|
||||||
|
(find-file org-default-inbox-file)
|
||||||
|
(delete-other-windows)
|
||||||
|
(ignore-errors
|
||||||
|
(ha/org-agenda))
|
||||||
|
(delete-other-windows)
|
||||||
|
(split-window-right-and-focus)
|
||||||
|
(pop-to-buffer (get-file-buffer org-default-inbox-file))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(org-next-visible-heading 1)
|
||||||
|
(hydra-org-refiler/body)))
|
||||||
|
|
||||||
|
(defun ha/org-agenda ()
|
||||||
|
"Displays my favorite agenda perspective."
|
||||||
|
(interactive)
|
||||||
|
(org-agenda nil "a")
|
||||||
|
(get-buffer "*Org Agenda*")
|
||||||
|
(execute-kbd-macro (kbd "A t")))
|
||||||
|
|
||||||
|
(provide 'boxes)
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;; boxes.el ends here
|
||||||
74
elisp/ha-focus.el
Normal file
74
elisp/ha-focus.el
Normal file
|
|
@ -0,0 +1,74 @@
|
||||||
|
;;; ha-focus.el --- Emacs lisp code to focus my thoughts. -*- lexical-binding: t; -*-
|
||||||
|
;;
|
||||||
|
;; Copyright (C) 2021 Howard X. Abrams
|
||||||
|
;;
|
||||||
|
;; Author: Howard X. Abrams <http://gitlab.com/howardabrams>
|
||||||
|
;; Maintainer: Howard X. Abrams <howard.abrams@workday.com>
|
||||||
|
;; Created: May 28, 2021
|
||||||
|
;;
|
||||||
|
;; This file is not part of GNU Emacs.
|
||||||
|
;;
|
||||||
|
;; *NB:* Do not edit this file. Instead, edit the original literate file at:
|
||||||
|
;; ~/website/Technical/Emacs/focused-work.org
|
||||||
|
;; And tangle the file to recreate this one.
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(defvar ha-focus-timer nil "A timer reference for the ha-focus functions")
|
||||||
|
|
||||||
|
(defun ha-focus-countdown-timer (minutes fun)
|
||||||
|
(let ((the-future (* minutes 60)))
|
||||||
|
(run-at-time the-future nil fun)))
|
||||||
|
|
||||||
|
(defun ha-focus-begin ()
|
||||||
|
"Start a concerted, focused effort, ala Pomodoro Technique.
|
||||||
|
We first clock into the current org-mode header (or last one),
|
||||||
|
start some music to indicate we are working, and set a timer.
|
||||||
|
|
||||||
|
Call `ha-focus-break' when finished."
|
||||||
|
(interactive)
|
||||||
|
(ha-focus-countdown-timer 25 'ha-focus-break)
|
||||||
|
(ha-focus--command "tell application \"Spotify\" to play")
|
||||||
|
(if (eq major-mode 'org-mode)
|
||||||
|
(org-clock-in)
|
||||||
|
(org-clock-in-last)))
|
||||||
|
|
||||||
|
(defun ha-focus-break ()
|
||||||
|
"Stop the focused time by stopping the music.
|
||||||
|
This also starts another break timer, that calls
|
||||||
|
`ha-focus-break-over' when finished."
|
||||||
|
(interactive)
|
||||||
|
(run-with-idle-timer 5 nil 'ha-focus-capture)
|
||||||
|
(ha-focus--command "tell application \"Spotify\" to pause")
|
||||||
|
(message "Time to take a break."))
|
||||||
|
|
||||||
|
(defun ha-focus-capture ()
|
||||||
|
(ignore-errors
|
||||||
|
(org-capture nil "cc")
|
||||||
|
(sit-for 1)
|
||||||
|
(org-clock-out))
|
||||||
|
(ha-focus-countdown-timer 5 'ha-focus-break-over)
|
||||||
|
(message "Taking a much needed break..."))
|
||||||
|
|
||||||
|
(defun ha-focus-break-over ()
|
||||||
|
"Message me to know that the break time is over. Notice that
|
||||||
|
this doesn't start anything automatically, as I may have simply
|
||||||
|
wandered off."
|
||||||
|
(ha-focus--command "set v to output volume of (get volume settings)
|
||||||
|
set volume output volume 1
|
||||||
|
say \"Break time over. Back on your head.\"
|
||||||
|
set volume output volume v"))
|
||||||
|
|
||||||
|
(defun ha-focus--command (osascript)
|
||||||
|
"Runs OSASCRIPT by passing to the `osascript' command asynchronously."
|
||||||
|
(async-start-process "focus-os" "osascript" 'ha-focus--command-callback "-e" osascript))
|
||||||
|
|
||||||
|
(defun ha-focus--command-callback (proc)
|
||||||
|
"Asynchronously called when the `osascript' process finishes."
|
||||||
|
(message "Finished calling osascript."))
|
||||||
|
|
||||||
|
(global-set-key (kbd "<f15>") 'ha-focus-begin)
|
||||||
|
(global-set-key (kbd "S-<f15>") 'ha-focus-break)
|
||||||
|
|
||||||
|
(provide 'ha-focus)
|
||||||
|
;;; ha-focus.el ends here
|
||||||
Loading…
Reference in a new issue