howard/hamacs
howard/hamacs
1
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Getting work-specific code to work

Browse source 
This includes some org-specific stuff, like my Sprint and clipboard code.
This commit is contained in:
Howard Abrams 2021-11-05 17:06:55 -07:00
parent d7b3bd3ef7
commit d3f14de2ee
6 changed files with 767 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
.gitignore vendored
View file

@ -1,6 +1,3 @@
*~
/bootstrap.el
/ha-config.el
/ha-display.el
/ha-org-word-processor.el
/ha-org.el
/*.el
/ha-work.org

67
bootstrap.org
View file

@ -57,6 +57,10 @@ The following packages come with Emacs, but seems like they still need loading:
#+BEGIN_SRC emacs-lisp
(require 'subr-x)
#+END_SRC
Ugh. Why am I getting this error?
#+BEGIN_SRC emacs-lisp
(defun first (elt) (car elt))
#+END_SRC
While most libraries will take care of their dependencies, I want to install /my dependent libraries/. Especially, [[https://github.com/magnars/.emacs.d/][Magnar Sveen]]'s Clojure-inspired [[https://github.com/magnars/dash.el][dash.el]] project:
#+BEGIN_SRC emacs-lisp
(use-package dash)
@ -78,31 +82,54 @@ Much of my more complicated code comes from my website essays and other projects
#+END_SRC
Hopefully, this will tie me over while I transition.
** Emacs Server Control
Sure the Emacs application will almost always have the =server-start= going, however, I need to control it just a bit (because I often have two instances running on some of my machines). What /defines/ the Emacs instance for work changes ... often:
#+BEGIN_SRC emacs-lisp
(defun ha-emacs-for-work? ()
"Return non-nil when the Emacs application's location matches as one for work.
Currently, this is the `emacs-plus' app that I have built with
the native-comp model, but I reserve the right to change this."
(->> Info-default-directory-list
(first)
(s-split "/")
(--filter (s-starts-with? "emacs-plus" it))
(first)))
#+END_SRC
#+BEGIN_SRC emacs-lisp
(if (ha-emacs-for-work?)
(setq server-name "work")
(setq server-name "personal"))
(server-start)
#+END_SRC
* Load the Rest
The following loads the rest of my org-mode literate files. I add them as they are /ready/, but eventually, I'll trim this up into a nicer pattern.
#+BEGIN_SRC emacs-lisp
(dolist (file '("ha-config.org"
"ha-display.org"
"ha-org.org"
"ha-org-word-processor.org"
;; "org-clipboard.org"
;; "org-journaling.org"
;; "org-publishing.org"
;; "org-sprint.org"
;; "capturing-notes.org"
;; "general-programming.org"
;; "ha-agendas.org"
;; "ha-email.org"
;; "ha-irc.org"
;; "ha-passwords.org"
;; "ha-remoting.org"
;; "my-feeds.org"
))
(org-babel-load-file (f-join hamacs-source-dir file)))
(dolist (file `("ha-config.org"
"ha-display.org"
"ha-org.org"
"ha-org-word-processor.org"
"ha-org-clipboard.org"
;; "org-journaling.org"
;; "org-publishing.org"
"ha-org-sprint.org"
;; "capturing-notes.org"
;; "general-programming.org"
;; "ha-agendas.org"
;; "ha-email.org"
;; "ha-irc.org"
;; "ha-passwords.org"
;; "ha-remoting.org"
;; "my-feeds.org"
,(when (ha-emacs-for-work?)
"ha-work.org")))
(org-babel-load-file (f-join hamacs-source-dir file)))
#+END_SRC
We can test/debug any individual file, via:
#+BEGIN_SRC emacs-lisp
(org-babel-load-file (f-join hamacs-source-dir "ha-config.org"))
#+BEGIN_SRC emacs-lisp :tangle no
(org-babel-load-file (f-join hamacs-source-dir "ha-org-word-processor.org"))
#+END_SRC
* Technical Artifacts :noexport:
Let's provide a name so that the file can be required:

78
ha-org-babel.org Normal file
View file

@ -0,0 +1,78 @@
#+TITLE: Literate Programming with Org
#+AUTHOR: Howard X. Abrams
#+EMAIL: howard.abrams@gmail.com
#+DATE: 2021-11-05
#+FILETAGS: :emacs:
This section is primarily about development in a literate way, especially focused on [[http://howardism.org/Technical/Emacs/literate-devops.html][literate devops]].
#+BEGIN_SRC emacs-lisp :exports none
;;; ha-org-babel.el --- -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2021 Howard X. Abrams
;;
;; Author: Howard X. Abrams <http://gitlab.com/howardabrams>
;; Maintainer: Howard X. Abrams <howard.abrams@gmail.com>
;; Created: November 5, 2021
;;
;; This file is not part of GNU Emacs.
;;
;; *NB:* Do not edit this file. Instead, edit the original literate file at:
;; /Users/howard.abrams/other/hamacs/ha-org-babel.org
;; And tangle the file to recreate this one.
;;
;;; Code:
#+END_SRC
* Introduction
Let's turn on all the languages:
#+BEGIN_SRC emacs-lisp
(use-package org
:init
(setq org-confirm-babel-evaluate nil
org-src-fontify-natively t
org-src-tab-acts-natively t)
:config
(add-to-list 'org-src-lang-modes '("dot" . "graphviz-dot"))
(org-babel-do-load-languages 'org-babel-load-languages
'((shell . t)
(js . t)
(emacs-lisp . t)
(clojure . t)
(python . t)
(ruby . t)
(dot . t)
(css . t)
(plantuml . t))))
#+END_SRC
#+RESULTS:
: t
* Technical Artifacts :noexport:
Let's provide a name so that the file can be required:
#+BEGIN_SRC emacs-lisp :exports none
(provide 'ha-org-babel)
;;; ha-org-babel.el ends here
#+END_SRC
Before you can build this on a new system, make sure that you put the cursor over any of these properties, and hit: ~C-c C-c~
#+DESCRIPTION:
#+PROPERTY: header-args:sh :tangle no
#+PROPERTY: header-args:emacs-lisp :tangle yes
#+PROPERTY: header-args :results none :eval no-export :comments no mkdirp yes
#+OPTIONS: num:nil toc:nil todo:nil tasks:nil tags:nil date:nil
#+OPTIONS: skip:nil author:nil email:nil creator:nil timestamp:nil
#+INFOJS_OPT: view:nil toc:nil ltoc:t mouse:underline buttons:0 path:http://orgmode.org/org-info.js
# Local Variables:
# eval: (add-hook 'after-save-hook #'org-babel-tangle t t)
# End:

190
ha-org-clipboard.org Normal file
View file

@ -0,0 +1,190 @@
#+TITLE: Pasting the Org Clipboard
#+AUTHOR: Howard X. Abrams
#+EMAIL: howard.abrams@gmail.com
#+DATE: 2020-09-15
#+FILETAGS: :emacs:
A literate programming file of functions for formatting the clipboard.
# *Note:* After each change, /tangle it/ to the source destination with ~C-c C-v t~.
#+BEGIN_SRC emacs-lisp :exports none
;;; org-clipboard.el --- A literate programming file of functions for formatting the clipboard. -*- 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: September 15, 2020
;;
;; This file is not part of GNU Emacs.
;;
;; *NB:* Do not edit this file. Instead, edit the original literate file at:
;; /home/howard/other/hamacs/org-clipboard.org
;; And tangle the file to recreate this one.
;;
;;; Code:
#+END_SRC
* Introduction
I would like to paste the formatted contents of the clipboard into an Org file /as org-formatted text/.
* The Clipboard
Functions to help convert content from the operating system's clipboard into org-mode-compatible text.
Each operating system as a different way of working with the clipboard, so let's create an operating-system abstraction:
#+BEGIN_SRC emacs-lisp
(defun ha/get-clipboard ()
"Returns a list where the first entry is the content type,
either :html or :text, and the second is the clipboard contents."
(if (eq system-type 'darwin)
(ha/get-mac-clipboard)
(ha/get-linux-clipboard)))
#+END_SRC
Let's define the clipboard for a Mac. The challenge here is that we need to binary unpack the data from a call to Applescript.
#+BEGIN_SRC emacs-lisp
(defun ha/get-mac-clipboard ()
"Returns a list where the first entry is the content type,
either :html or :text, and the second is the clipboard contents."
(destructuring-bind (exit-code contents)
(shell-command-with-exit-code "osascript" "-e" "the clipboard as \"HTML\"")
(if (= 0 exit-code)
(list :html (ha/convert-applescript-to-html contents))
(list :text (shell-command-to-string "osascript -e 'the clipboard'")))))
(defun ha/convert-applescript-to-html (packed-contents)
"Applescript's clipboard returns the contents in a packed array.
Convert and return this encoding into a UTF-8 string."
(cl-flet ((hex-pack-bytes (tuple) (string-to-number (apply 'string tuple) 16)))
(let* ((data (-> packed-contents
(substring 10 -2) ; strips off the =«data RTF= and =»\= bits
(string-to-list)))
(byte-seq (->> data
(-partition 2) ; group each two hex characters into tuple
(mapcar #'hex-pack-bytes))))
(decode-coding-string
(mapconcat #'byte-to-string byte-seq "") 'utf-8))))
#+END_SRC
And define the same interface for Linux. Keep in mind, we need the exit code from calling a process, so I am going to define/use a helper function (that really should go into the piper project).
#+BEGIN_SRC emacs-lisp
(defun ha/get-linux-clipboard ()
"Return the clipbaard for a Unix-based system. See `ha/get-clipboard'."
(destructuring-bind (exit-code contents)
(shell-command-with-exit-code "xclip" "-o" "-t" "text/html")
(if (= 0 exit-code)
(list :html contents)
(list :text (shell-command-to-string "xclip -o")))))
(defun shell-command-with-exit-code (program &rest args)
"Run PROGRAM with ARGS and return the exit code and output in a list."
(with-temp-buffer
(list (apply 'call-process program nil (current-buffer) nil args)
(buffer-string))))
#+END_SRC
* Converting from Slack
We can assume that most non-HTML text could be Slack-like:
#+BEGIN_SRC emacs-lisp
(defun ha/slack-to-markdown-buffer ()
"Odd function that converts Slack’s version of Markdown (where
code is delimited with triple backticks) into a more formal
four-space indent markdown style."
(goto-char (point-min))
;; Begin by converting all Carriage Returns to line feeds:
(while (re-search-forward " " nil t)
(replace-match "
"))
(goto-char (point-min))
(while (re-search-forward "```" nil t)
(replace-match "
")
(let ((starting-bounds (point)))
(if (re-search-forward "```[ \t]*" nil t)
(let ((ending-bounds (point)))
(replace-match "
")
(goto-char starting-bounds)
(while (< (point) ending-bounds)
(next-line)
(beginning-of-line)
(insert " ")))))))
#+END_SRC
* Converting to Org
Let's work top-down at this point with the interactive function that inserts the clipboard into the current buffer:
#+BEGIN_SRC emacs-lisp
(defun ha/org-yank-clipboard ()
"Yanks (pastes) the contents of the Apple Mac clipboard in an
org-mode-compatible format."
(interactive)
(insert (ha/org-clipboard)))
#+END_SRC
The heavy lifting, however is done by this function. Note that I will need another function to tidy up the output from =pandoc= that will be more to my liking.
#+BEGIN_SRC emacs-lisp
(defun ha/org-clipboard ()
"Return the contents of the clipboard in org-mode format."
(seq-let (type contents) (ha/get-clipboard)
(with-temp-buffer
(insert contents)
(if (eq :html type)
(shell-command-on-region (point-min) (point-max) "pandoc -f html -t org" t t)
(ha/slack-to-markdown-buffer)
(shell-command-on-region (point-min) (point-max) "pandoc -f markdown -t org" t t))
(ha/html-paste-touchup)
(buffer-substring-no-properties (point-min) (point-max)))))
(defun ha/html-paste-touchup ()
"Attempts to fix the org produced by `pandoc'' that seems to plague us."
(interactive)
(dolist (combo '((" (edited) " " ") ; Slack appends this phrase that is never needed
(" " " ") ; Pandoc's fixed space needs to go
("\\\\\\\\$" "") ; Pandoc's fixed space needs to go
("\\[\\[https://slack-imgs\\.com/.*\\.png\\]\\]" "") ;; Emoticons associated with a user
("\\[\\[https://.*\\.slack\\.com/archives.*\\]\\[\\(.*\n.*\\)\\]\\]" "")
("\\[\\[https://app\.slack\.com/team.*\\]\\[\\(.*\\)\n\\(.*\\)\\]\\]" " - *\\1 \\2:* ")
("\\[\\[https://app\.slack\.com/team.*\\]\\[\\(.*\n.*\\)\\]\\]" " - *\\1:* ")
("^- \\(.*\\)\\n " "- \\1 ")
("^ *<<[0-9\.]+>>\n\n" ""))) ;; Slack includes these time things?
(seq-let (search replace) combo
(goto-char (point-min))
(while (re-search-forward search nil t)
(replace-match replace)))))
#+END_SRC
* Keybinding to Paste into Org Files
We
#+BEGIN_SRC emacs-lisp
(general-evil-define-key 'normal org-mode-map
:prefix "SPC m"
"y" 'ha/org-yank-clipboard)
#+END_SRC
* Technical Artifacts :noexport:
Let's provide a name so we can =require= this file:
#+BEGIN_SRC emacs-lisp
(provide 'ha-org-clipboard)
;;; ha-org-clipboard.el ends here
#+END_SRC
#+DESCRIPTION: A literate programming version of functions for formatting the clipboard.
#+PROPERTY: header-args:sh :tangle no
#+PROPERTY: header-args:emacs-lisp :tangle yes
#+PROPERTY: header-args :results none :eval no-export :comments no mkdirp yes
#+OPTIONS: num:nil toc:nil todo:nil tasks:nil tags:nil date:nil
#+OPTIONS: skip:nil author:nil email:nil creator:nil timestamp:nil
#+INFOJS_OPT: view:nil toc:nil ltoc:t mouse:underline buttons:0 path:http://orgmode.org/org-info.js

434
ha-org-sprint.org Normal file
View file

@ -0,0 +1,434 @@
#+TITLE: My Sprint Calculations and Support
#+AUTHOR: Howard X. Abrams
#+EMAIL: howard.abrams@gmail.com
#+DATE: 2020-09-25
#+FILETAGS: :emacs:
A literate program for configuring org files for work-related notes.
# *Note:* After each change, /tangle it/ to the source destination with ~C-c C-v t~.
#+BEGIN_SRC emacs-lisp :exports none
;;; org-sp rint.el --- A literate program for configuring org files for work-related notes. -*- 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: September 25, 2020
;;
;; This file is not part of GNU Emacs.
;;
;; *NB:* Do not edit this file. Instead, edit the original literate file at:
;; /Users/howard.abrams/other/hamacs/org-sprint.org
;; And tangle the file to recreate this one.
;;
;;; Code:
#+END_SRC
* Introduction
At the beginning of each Sprint, I create a new org file dedicated to it. This workflow/technique strikes a balance between a single ever-growing file, and a thousand tiny ones. This also gives me a sense of continuity, as the filename of each sprint is date-based.
I want a single keybinding that always displays the current Sprint note file, regardless of what Sprint it is. This means, I need to have functions that can calculate what this is.
In order to have the Org Capture features to be able to write to correct locations in the current file, I need each file to follow a particular format. I create a [[file:snippets/org-mode/__sprint.org][sprint note template]] that will be automatically expanded with a new sprint.
This template needs the following functions:
- =sprint-current-name= to be both the numeric label as well as the nickname
- =sprint-date-range= to include a org-formatted date range beginning and ending the sprint
- =sprint-date-from-start= return a date for pre-scheduled and recurring meetings
* Naming Sprints
I give each sprint a nickname, based on a /theme/ of some sorts, alphabetized. Since our sprints are every two weeks, this allows me to go through the alphabet once. Yeah, my group likes to boringly /number/ the sprints, so I do both...mostly for myself.
At the beginning of the year, I choose a theme, and make a list for the upcoming sprints. In the org file, this is just a list, that gets /tangled/ into an actual Emacs LIsp list. This is pretty cool.
#+BEGIN_SRC emacs-lisp :noweb yes
(defvar sprint-nicknames
(--map (replace-regexp-in-string " *[:#].*" "" (first it))
'<<sprint-names-2021()>>)
"List of 26 Sprint Nicknames from A to Z.")
#+END_SRC
** 2022
Fun sprint names for 2021 lists my favorite D&D monsters, also see [[https://list.fandom.com/wiki/List_of_monsters][this list of monsters]] from mythology and other sources:
#+NAME: sprint-names-2022
- ankheg
- beholder
- centaur
- dragon
- elf
- fetch
- goblin
- hydra
- illythid
- jackalwere
- kobold
- lich
- mimic
- nymph
- owlbear
- pegasus
- quasit
- remorhaz
- satyr
- troll
- unicorn
- vampire
- warg
- xorn
- yuan-ti
- zombie
** 2021
Choosing Sprint Names based on [[https://www.imagineforest.com/blog/funniest-words-in-the-english-language/][Funny or Silly Words]]:
#+NAME: sprint-names-2021
- abibliophobia :: The fear of running out of reading materials to read
- bamboozled :: To trick or confuse someone
- catawampus :: Something positioned diagonally
- dweeb :: A boring and uninteresting person
- eep :: Another expression of surprise or fear.
- formication :: The feeling that ants are crawling on your skin.
- goombah :: An older friend who protects you.
- hootenanny :: A country music party or get-together.
- Izzat :: This relates to your personal respect and dignity.
- jabberwock :: Something that is complete nonsense or gibberish
- kebbie :: A Scottish term relating to a walking stick with a hooked end.
- lollygagger :: Someone who walks around with no aim or goal.
- mollycoddle :: To be extra nice to someone or to overprotect them.
- nacket :: A light lunch or snack.
- obi :: A sash worn around the waist of a kimono
- panjandrum :: Someone who thinks that they are superior to others.
- quoz :: Something that is strange.
- ratoon :: The small root that sprouts from a plant, especially during the springtime.
- sialoquent :: Someone who splits while talking.
- taradiddle :: this is a small lie or when someone is speaking nonsense.
- urubu :: A blank vulture found in South American.
- vamp :: To make something brand-new.
- wabbit :: A Scottish word referring to feeling exhausted or a little unwell.
- xanthoderm :: A person with yellowish skin.
- yerk :: Pull or push something with a sudden movement.
- zazzy :: Something that is shiny and flashy
** 2020
New names from [[https://en.m.wikipedia.org/wiki/List_of_dinosaur_genera][list of dinosaurs]].
#+NAME: sprint-names-2020
- ankylosaurus
- brontosaurus
- coelophysis
- diplodocus
- eoraptor
- fruitadens
- gobiceratops
- harpymimus
- iguanodozn
- jinfengopteryx
- kentrosaurus
- lambeosaurus
- maiasaura
- neimongosaurus
- oviraptor
- pachycephalosaurus
- quetzalcoatlus
- rioarribasaurus
- stegosaurus
- tyrannosaurus
- utahraptor
- velociraptor
- wannanosaurus
- xiaotingia
- yi
- zuul
** 2019
Came up with a list of somewhat well-known cities throughout the world (at least, they had to have a population of 100,000 or more), but I didn't want any real obvious ones.
#+NAME: sprint-names-2019
- achy-aachen
- bare-bacabal
- candid-cannes
- darling-dadu
- easy-edmonton
- fancy-fargo
- gray-gaya
- handsome-hanoi
- itchy-incheon
- jumpy-juba
- kind-kindia
- less-liling
- mad-madrid
- natural-naga
- octarine-oakland
- painful-paris
- quirky-qufu
- rabid-rabat
- slow-slough
- typing-taipei
- ugly-ufa
- vibrant-vienna
- wacky-waco
- xenophobic-xichang
- yellow-yamaguchi
- zippy-zinder
* Sprint Boundaries
Function to help in calculating dates and other features of a two-week sprint that starts on Thursday and ends on a Wednesday...hey, that is just how we do things at my job.
Emacs have an internal rep of a time.
#+BEGIN_SRC emacs-lisp
(defun get-date-time (date)
"Many functions can't deal with dates as string, so this will
parse DATE if it is a string, or return the value given otherwise."
(if (stringp date)
(->> date ; Shame that encode-time
parse-time-string ; can't take a string, as
(-take 6) ; this seems excessive...
(--map (if (null it) 0 it))
(apply 'encode-time))
date))
#+END_SRC
** Sprint Numbering
My Sprint starts on Thursday, but this sometimes changed, so let's make this a variable:
#+BEGIN_SRC emacs-lisp
(defvar sprint-starting-day 2 "The day of the week the sprint begins, where 0 is Sunday.")
#+END_SRC
We label our sprint based on the week number that it starts. However, on a Monday, I want to consider that we are still numbering from last week.
#+BEGIN_SRC emacs-lisp
(defun sprint-week-num (&optional date)
"Return the week of the current year (or DATE), but starting
the week at Thursday to Wednesday."
(let* ((d (get-date-time date))
(dow (nth 6 (decode-time d))) ; Day of the week 0=Sunday
(week (->> d ; Week number in the year
(format-time-string "%U")
string-to-number)))
(if (>= dow sprint-starting-day)
(1+ week)
week)))
#+END_SRC
Let's have a few tests to make sure, and yeah, perhaps we update this at the beginning of each year.
#+BEGIN_SRC emacs-lisp :tangle no
(ert-deftest sprint-week-num-test ()
(should (= (sprint-week-num "2021-03-15") 11)) ;; Monday previous week
(should (= (sprint-week-num "2021-03-16") 12)) ;; Tuesday current week
(should (= (sprint-week-num "2021-03-19") 12)))
#+END_SRC
Since my sprints are currently two weeks long, we could be see that on even week numbers, the /sprint/ is actually the previous week's number.
And it appears that my PM for this year, is a week number behind.
#+BEGIN_SRC emacs-lisp
(defun sprint-number (&optional date)
"Return the current sprint number, with some assumptions that
each sprint is two weeks long, starting on Thursday."
(interactive)
(let ((num (sprint-week-num date)))
(if (oddp num)
(- num 2)
(- num 1))))
#+END_SRC
And some tests to verify that:
#+BEGIN_SRC emacs-lisp :tangle no
(ert-deftest sprint-number-test ()
(should (= (sprint-number "2021-03-15") 9))
(should (= (sprint-number "2021-03-16") 11))
(should (= (sprint-number "2021-03-22") 11))
(should (= (sprint-number "2021-03-23") 11))
(should (= (sprint-number "2021-03-29") 11))
(should (= (sprint-number "2021-03-30") 13)))
#+END_SRC
** Sprint File Name
I create my org-file notes based on the Sprint number.
#+BEGIN_SRC emacs-lisp
(defun sprint-current-file (&optional date)
"Return the absolute pathname to the current sprint file."
(let ((d (get-date-time date)))
(expand-file-name
(format "~/Notes/Sprint-%s-%02d.org"
(format-time-string "%Y" d)
(sprint-number d)))))
#+END_SRC
So what that means, is given a particular date, I should expect to be able to find the correct Sprint file name:
#+BEGIN_SRC emacs-lisp :tangle no
(ert-deftest sprint-current-file-test ()
(should (s-ends-with? "Sprint-2019-05.org" (sprint-current-file "2019-02-07")))
(should (s-ends-with? "Sprint-2019-05.org" (sprint-current-file "2019-02-09")))
(should (s-ends-with? "Sprint-2019-05.org" (sprint-current-file "2019-02-10")))
(should (s-ends-with? "Sprint-2019-05.org" (sprint-current-file "2019-02-13")))
(should (s-ends-with? "Sprint-2019-07.org" (sprint-current-file "2019-02-14")))
(should (s-ends-with? "Sprint-2019-07.org" (sprint-current-file "2019-02-17"))))
#+END_SRC
Daily note-taking goes into my sprint file notes, so this interactive function makes an easy global short-cut key.
#+BEGIN_SRC emacs-lisp
(defun sprint-current-find-file (&optional date)
"Load the `org-mode' note associated with my current sprint."
(interactive)
(find-file (sprint-current-file date)))
#+END_SRC
The /name/ and /nickname/ of the sprint will be used in the =#+TITLE= section, and it looks something like: =Sprint 2019-07 (darling-dadu)=
#+BEGIN_SRC emacs-lisp
(defun sprint-current-name (&optional date)
"Return the default name of the current sprint (based on DATE)."
(let* ((d (get-date-time date))
(sprint-order (/ (1- (sprint-number d)) 2))
(nickname (nth sprint-order sprint-nicknames)))
(format "Sprint %s-%02d %s"
(format-time-string "%Y" d)
(sprint-number d)
nickname)))
#+END_SRC
These test won't pass any more, as the nickname of the sprint changes from year to year.
#+BEGIN_SRC emacs-lisp :tangle no
(ert-deftest sprint-current-name-test ()
(should (equal "Sprint 2019-05 (candid-cannes)" (sprint-current-name "2019-02-13")))
(should (equal "Sprint 2019-07 (darling-dadu)" (sprint-current-name "2019-02-14"))))
#+END_SRC
** Sprint Start and End
I want to print the beginning and ending of the sprint, where we have a sprint number or a data, and we can give the dates that bound the sprint. This odd function calculates this based on knowing the date of the /first thursday/ of the year, so I need to begin the year changing this value. I should fix this.
#+BEGIN_SRC emacs-lisp
(defun sprint-range (&optional number-or-date)
"Return a list of three entries, start of the current sprint,
end of the current sprint, and the start of the next sprint.
Each date value should be formatted with `format-time-string'."
(let* ((num (if (or (null number-or-date) (stringp number-or-date))
(sprint-number number-or-date)
number-or-date))
(year-start "2020-01-02") ; First Thursday of the year
(time-start (-> year-start ; Converted to time
get-date-time
float-time))
(day-length (* 3600 24)) ; Length of day in seconds
(week-length (* day-length 7))
(sprint-start (time-add time-start (* week-length (1- num))))
(sprint-next (time-add time-start (* week-length (1+ num))))
(sprint-end (time-add sprint-next (- day-length))))
(list sprint-start sprint-end sprint-next)))
#+END_SRC
Format the start and end so that we can insert this directly in the org file:
#+BEGIN_SRC emacs-lisp
(defun sprint-date-range (&optional number-or-date)
"Return an `org-mode' formatted date range for a given sprint
number or date, `NUMBER-OR-DATE' or if `nil', the date range of
the current sprint."
(seq-let (sprint-start sprint-end) (sprint-range number-or-date)
(let* ((formatter "%Y-%m-%d %a")
(start (format-time-string formatter sprint-start))
(end (format-time-string formatter sprint-end)))
(format "[%s]--[%s]" start end))))
#+END_SRC
And let's have a test to validate this:
#+BEGIN_SRC emacs-lisp
(ert-deftest sprint-date-range ()
(should (equal (sprint-date-range 7)
(sprint-date-range "2020-02-17"))))
#+END_SRC
** Pre-scheduled Dates
Due to the regularity of the sprint cadence, I can pre-schedule meetings and other deadlines by /counting/ the number of days from the start of the sprint:
#+BEGIN_SRC emacs-lisp
(defun sprint-date-from-start (days &optional formatter)
"Given a number of DAYS from the start of the sprint, return a formatted date string."
(let* ((day-length (* 3600 24))
(start (car (sprint-range)))
(adate (time-add start (* day-length days))))
(if formatter
(format-time-string formatter adate)
(format-time-string "%Y-%m-%d %a" adate))))
#+END_SRC
* Other Date Functions
The following functions /were/ helpful at times. But I'm not sure I will use them.
#+BEGIN_SRC emacs-lisp :tangle no
(defun sprint-num-days (time-interval)
"Converts a TIME-INTERVAL to a number of days."
(let ((day-length (* 3600 24)))
(round (/ (float-time time-interval) day-length))))
#+END_SRC
#+BEGIN_SRC emacs-lisp :tangle no
(defun sprint-day-range (&optional date)
"Returns a list of two values, the number of days from the
start of the sprint, and the number of days to the end of the
sprint based on DATE if given, or from today if DATE is `nil'."
(seq-let (sprint-start sprint-end) (sprint-range date)
(let* ((now (get-date-time date))
(starting (time-subtract sprint-start now))
(ending (time-subtract sprint-end now)))
(list (sprint-num-days starting) (sprint-num-days ending)))))
#+END_SRC
#+BEGIN_SRC emacs-lisp :tangle no
(ert-deftest sprint-day-range ()
;; This sprint starts on 2/13 and ends on 2/26
(should (equal '(0 13) (sprint-day-range "2020-02-13")))
(should (equal '(-1 12) (sprint-day-range "2020-02-14")))
(should (equal '(-13 0) (sprint-day-range "2020-02-26"))))
#+END_SRC
#+BEGIN_SRC emacs-lisp :tangle no
(defun sprint-day-start (&optional date)
"Return a relative number of days to the start of the current sprint. For instance, if today was Friday, and the sprint started on Thursday, this would return -1."
(first (sprint-day-range date)))
(defun sprint-day-end (&optional date)
"Return a relative number of days to the end of the current sprint. For instance, if today was Monday, and the sprint will end on Wednesday, this would return 3."
(second (sprint-day-range date)))
#+END_SRC
* Technical Artifacts :noexport:
Let's provide a name so that the file can be required:
#+BEGIN_SRC emacs-lisp :exports none
(provide 'ha-org-sprint)
;;; ha-org-sprint.el ends here
#+END_SRC
Before you can build this on a new system, make sure that you put the cursor over any of these properties, and hit: ~C-c C-c~
#+DESCRIPTION: A literate program for configuring org files for work-related notes.
#+PROPERTY: header-args:sh :tangle no
#+PROPERTY: header-args:emacs-lisp yes
#+PROPERTY: header-args :results none :eval no-export :comments no mkdirp yes
#+OPTIONS: num:nil toc:nil todo:nil tasks:nil tags:nil date:nil
#+OPTIONS: skip:nil author:nil email:nil creator:nil timestamp:nil
#+INFOJS_OPT: view:nil toc:nil ltoc:t mouse:underline buttons:0 path:http://orgmode.org/org-info.js

18
ha-org.org
View file

@ -241,10 +241,24 @@ Of course, I need an 'undo' feature when the meeting is over...
Whenever I edit Emacs Lisp blocks from my tangle-able configuration files, I get a lot of superfluous warnings. Let's turn them off.
#+BEGIN_SRC emacs-lisp
(defun disable-fylcheck-in-org-src-block ()
(defun disable-flycheck-in-org-src-block ()
(setq-local flycheck-disabled-checkers '(emacs-lisp-checkdoc)))
(add-hook 'org-src-mode-hook 'disable-fylcheck-in-org-src-block)
(add-hook 'org-src-mode-hook 'disable-flycheck-in-org-src-block)
#+END_SRC
And turn on ALL the languages:
#+BEGIN_SRC emacs-lisp
(org-babel-do-load-languages 'org-babel-load-languages
'((shell . t)
(js . t)
(emacs-lisp . t)
(clojure . t)
(python . t)
(ruby . t)
(dot . t)
(css . t)
(plantuml . t)))
#+END_SRC
*** Next Image
When I create images or other artifacts that I consider /part/ of the org document, I want to have them based on the org file, but with a prepended number. Keeping track of what numbers are now free is difficult, so for a /default/ let's figure it out: