changelog shortlog graph tags branches files raw help

Mercurial > infra > home / changeset: add stumpwm modules and org-timeline

changeset 94: 978ce75e54af
parent 93: 0e41a0a68353
child 95: f69061a590da
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 30 Aug 2024 17:07:30 -0400
files: .emacs.d/ellis.el .emacs.d/lib/org-timeline.el .stumpwm.d/init.lisp
description: add stumpwm modules and org-timeline
     1.1--- a/.emacs.d/ellis.el	Fri Aug 23 19:12:13 2024 -0400
     1.2+++ b/.emacs.d/ellis.el	Fri Aug 30 17:07:30 2024 -0400
     1.3@@ -30,12 +30,10 @@
     1.4 
     1.5 (defalias 'make #'compile)
     1.6 
     1.7-(setopt default-theme 'ef-dream
     1.8+(setq default-theme 'ef-dark
     1.9         user-lab-directory (join-paths user-home-directory "lab")
    1.10         company-source-directory (join-paths user-home-directory "comp"))
    1.11 
    1.12-;; (unless (display-graphic-p) (setq default-theme 'wheatgrass))
    1.13-
    1.14 (when (linux-p) (setq dired-listing-switches "-alsh"))
    1.15 
    1.16 (defvar emacs-config-source (join-paths company-source-directory "core/emacs"))
    1.17@@ -88,8 +86,8 @@
    1.18 ;; (add-hook 'prog-mode-hook #'company-mode)
    1.19 
    1.20 (add-hook 'notmuch-message-mode-hook #'turn-on-orgtbl)
    1.21-(
    1.22-ouse-package ef-themes :ensure t)
    1.23+
    1.24+(use-package ef-themes :ensure t)
    1.25 
    1.26 (use-package markdown-mode :ensure t)
    1.27 
    1.28@@ -240,9 +238,10 @@
    1.29 (use-package sh-script
    1.30   :hook (sh-mode . flymake-mode))
    1.31 
    1.32+;;; Diary
    1.33+(setq diary-list-include-blanks t)
    1.34 ;;; Org Config
    1.35 (setq publish-dir "/ssh:rurik:/srv/http/compiler.company")
    1.36-(keymap-set user-map "t" #'org-todo)
    1.37 
    1.38 ;; populate org-babel
    1.39 (org-babel-do-load-languages
    1.40@@ -261,6 +260,20 @@
    1.41 			     (python . t)
    1.42 			     (lua . t)
    1.43 			     (lilypond . t)))
    1.44+
    1.45+;; timeline
    1.46+(use-package org-timeline
    1.47+  :load-path user-emacs-lib-directory
    1.48+  :hook (org-agenda-finalize . org-timeline-insert-timeline)
    1.49+  :init
    1.50+  (setq
    1.51+   org-timeline-insert-before-text "›"
    1.52+   org-timeline-beginning-of-day-hour 8
    1.53+   org-timeline-keep-elapsed 2
    1.54+   org-timeline-start-hour 5
    1.55+   org-timeline-show-text-in-blocks t
    1.56+   org-timeline-prepend t))
    1.57+
    1.58 ;;; IRC
    1.59 (setq erc-format-nick-function 'erc-format-@nick)
    1.60 
    1.61@@ -565,23 +578,21 @@
    1.62      files)
    1.63     files))
    1.64 
    1.65-(defvar org-agenda-directories (list org-directory
    1.66-                                     ;; (join-paths user-lab-directory "org")
    1.67-                                     (join-paths company-source-directory "org/*")
    1.68-                                     (join-paths company-source-directory "org/*/*"))
    1.69+(defvar org-agenda-directories (list (join-paths company-source-directory "org/plan")
    1.70+                                     (join-paths company-source-directory "org/plan/tasks"))
    1.71   "List of directories containing org files.")
    1.72+
    1.73 (defvar org-agenda-extensions '(".org")
    1.74   "List of extensions of agenda files")
    1.75 
    1.76 (defun org-set-agenda-files ()
    1.77   (interactive)
    1.78   (setq org-agenda-files
    1.79-        (cl-remove-if (lambda (x) (or
    1.80-                                   (string= "archive.org" (file-name-nondirectory x))
    1.81-                                   (string= "archive" (file-name-directory x))))
    1.82-        (org-list-files
    1.83-         org-agenda-directories
    1.84-         org-agenda-extensions))))
    1.85+        (cons org-inbox-file
    1.86+              (cl-remove-if (lambda (x) (string= "readme.org" (file-name-nondirectory x)))
    1.87+                            (org-list-files
    1.88+                             org-agenda-directories
    1.89+                             org-agenda-extensions)))))
    1.90 
    1.91 (with-eval-after-load 'org
    1.92   (org-set-agenda-files))
    1.93@@ -751,5 +762,32 @@
    1.94 ;;   (cl-pushnew '("Terms" . glossary) org-glossary-headings)
    1.95 ;;   (cl-pushnew '("Acronyms" . acronym) org-glossary-headings))
    1.96 
    1.97+;;; Calc
    1.98+(setq calc-highlight-selections-with-faces t)
    1.99+(cl-pushnew '(lisp-mode "#| " "|#
   1.100+") calc-embedded-open-close-mode-alist)
   1.101+(cl-pushnew '(emacs-lisp-mode ";; " "
   1.102+") calc-embedded-open-close-mode-alist)
   1.103+
   1.104+(defun calc-eval-region (arg beg end)
   1.105+  "Calculate the region and display the result in the echo area.
   1.106+With prefix ARG non-nil, insert the result at the end of region."
   1.107+  (interactive "P\nr")
   1.108+  (let* ((expr (buffer-substring-no-properties beg end))
   1.109+         (result (calc-eval expr)))
   1.110+    (if (null arg)
   1.111+        (message "%s = %s" expr result)
   1.112+      (goto-char end)
   1.113+      (save-excursion
   1.114+        (insert result)))))
   1.115+
   1.116+(defun calc-embedded-formula-to-stack ()
   1.117+  (interactive)
   1.118+  (save-excursion
   1.119+    (save-match-data
   1.120+     (calc-embedded-find-bounds)))
   1.121+  (let ((eq-str (buffer-substring calc-embed-top calc-embed-bot)))
   1.122+    (calc-eval eq-str 'push)))
   1.123+
   1.124 (provide 'ellis)
   1.125 ;; ellis.el ends here
     2.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2+++ b/.emacs.d/lib/org-timeline.el	Fri Aug 30 17:07:30 2024 -0400
     2.3@@ -0,0 +1,660 @@
     2.4+;;; org-timeline.el --- Add graphical view of agenda to agenda buffer. -*- lexical-binding: t -*-
     2.5+
     2.6+;; Copyright (C) 2017 Matúš Goljer
     2.7+
     2.8+;; Author: Matúš Goljer <matus.goljer@gmail.com>
     2.9+;; Maintainer: Matúš Goljer <matus.goljer@gmail.com>
    2.10+;; Version: 0.3.0
    2.11+;; Created: 16th April 2017
    2.12+;; Package-requires: ((dash "2.13.0") (emacs "24.3"))
    2.13+;; Keywords: calendar
    2.14+;; URL: https://github.com/Fuco1/org-timeline/
    2.15+
    2.16+;; This program is free software; you can redistribute it and/or
    2.17+;; modify it under the terms of the GNU General Public License
    2.18+;; as published by the Free Software Foundation; either version 3
    2.19+;; of the License, or (at your option) any later version.
    2.20+
    2.21+;; This program is distributed in the hope that it will be useful,
    2.22+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
    2.23+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    2.24+;; GNU General Public License for more details.
    2.25+
    2.26+;; You should have received a copy of the GNU General Public License
    2.27+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
    2.28+
    2.29+;;; Commentary:
    2.30+
    2.31+;; Add graphical view of agenda to agenda buffer.
    2.32+
    2.33+;; This package adds a graphical view of the agenda after the last
    2.34+;; agenda line.  By default the display starts at 5 AM today and
    2.35+;; goes up to 4 AM next day (this covers 24 hours).
    2.36+
    2.37+;; Scheduled tasks or tasks with time ranges are rendered in the
    2.38+;; display with `org-timeline-block' face.  Clocked entires are
    2.39+;; displayed in `org-timeline-clocked' face.  
    2.40+
    2.41+;; You can use custom color for a task by adding the property
    2.42+;; `TIMELINE_FACE' with either a string which is a color name or a
    2.43+;; list which specifies the face properties or a symbol which is
    2.44+;; taken to be a face name.
    2.45+
    2.46+;;; Code:
    2.47+
    2.48+(require 'dash)
    2.49+
    2.50+(require 'org-agenda)
    2.51+
    2.52+(defgroup org-timeline ()
    2.53+  "Graphical view of agenda in agenda buffer."
    2.54+  :group 'org
    2.55+  :prefix "org-timeline-")
    2.56+
    2.57+(defgroup org-timeline-faces ()
    2.58+  "Faces for org-timeline."
    2.59+  :group 'org-timeline)
    2.60+
    2.61+(defcustom org-timeline-default-duration 60
    2.62+  "Default event duration in minutes"
    2.63+  :type 'integer
    2.64+  :group 'org-timeline)
    2.65+
    2.66+(defcustom org-timeline-prepend nil
    2.67+  "Option to prepend the timeline to the agenda."
    2.68+  :type 'boolean
    2.69+  :group 'org-timeline)
    2.70+
    2.71+(defcustom org-timeline-show-clocked t
    2.72+  "Option to show or hide clocked items."
    2.73+  :type 'boolean
    2.74+  :group 'org-timeline)
    2.75+
    2.76+(defcustom org-timeline-dedicated-clocked-line t
    2.77+  "Option to show clocked items in a dedicated line with 'group-name' '$'."
    2.78+  :type 'boolean
    2.79+  :group 'org-timeline)
    2.80+
    2.81+(defcustom org-timeline-overlap-in-new-line nil
    2.82+  "Option to create new lines for blocks that would otherwise overlap."
    2.83+  :type 'boolean
    2.84+  :group 'org-timeline)
    2.85+
    2.86+(defcustom org-timeline-emphasize-next-block nil
    2.87+  "Option to apply the face `org-timeline-next-block' to the next block happening today."
    2.88+  :type 'boolean
    2.89+  :group 'org-timeline)
    2.90+
    2.91+(defcustom org-timeline-show-text-in-blocks nil
    2.92+  "Option to show the text of the event in the block.
    2.93+
    2.94+If the item has a property `TIMELINE_TEXT', use this as a title.
    2.95+Otherwise, the title will be the item's headline, stripped of its todo state."
    2.96+  :type 'boolean
    2.97+  :group 'org-timeline)
    2.98+
    2.99+(defcustom org-timeline-beginning-of-day-hour 5
   2.100+  "When the timeline begins.
   2.101+
   2.102+Due to the way 'org-agenda' works, if you set this to any other value than 0
   2.103+\(e.g. 5), then events that happen after midnight will not appear (even though
   2.104+the timeline shows the slots).
   2.105+If you view the agenda in week mode, those events will not appear in any of
   2.106+the week's day.
   2.107+
   2.108+The workaround for this in day view is to use `org-timeline-keep-elapsed' that
   2.109+will make the timeline show you a 24h cycle. See this variable's documentation
   2.110+for more information."
   2.111+  :type 'integer
   2.112+  :group 'org-timeline)
   2.113+
   2.114+(defcustom org-timeline-keep-elapsed -1
   2.115+  "In day view, for today, keep only this number of fully elapsed hours.
   2.116+
   2.117+For negative values, do not hide elapsed hours.
   2.118+
   2.119+This can be used to see a rolling 24h cycle in the timeline.
   2.120+In order to do that, set `org-timeline-beginning-of-day-hour' to 0, and set
   2.121+`org-timeline-keep-elapsed' to any positive number.
   2.122+Set `org-agenda-span' to 2, and open the day agenda view for today.
   2.123+You will see a rolling 24h cycle, starting `org-timeline-keep-elapsed' hours ago."
   2.124+  :type 'integer
   2.125+  :group 'org-timeline)
   2.126+
   2.127+(defcustom org-timeline-insert-before-text "\u275A"
   2.128+  "String inserted before the block's text.
   2.129+
   2.130+It makes consecutive blocks distinct.
   2.131+
   2.132+The default value '\u275A' is a heavy vertical bar ❚."
   2.133+  :type 'string
   2.134+  :group 'org-timeline)
   2.135+
   2.136+(defvar org-timeline-first-line-in-agenda-buffer 0
   2.137+  "Line number of the first line of the timeline in the agenda buffer.")
   2.138+
   2.139+(defvar org-timeline-height 0
   2.140+  "Final height of the timeline.")
   2.141+
   2.142+(defvar org-timeline-current-info nil
   2.143+  "Current displayed info. Used to fix flickering of info.")
   2.144+
   2.145+(defvar org-timeline-slotline (concat (mapconcat 'not (number-sequence 0 24) "|     ") "|")
   2.146+  "The undecorated slotline string.")
   2.147+
   2.148+(defvar org-timeline-next-task-today nil
   2.149+  "The next task happening today.")
   2.150+
   2.151+(cl-defstruct org-timeline-task
   2.152+  id
   2.153+  beg  ; in minutes
   2.154+  end  ; in minutes
   2.155+  offset-beg ; in points
   2.156+  offset-end ; in points
   2.157+  info ; copy of the agenda buffer's line
   2.158+  line-in-agenda-buffer
   2.159+  face
   2.160+  day  ; absolute, see `calendar-absolute-from-gregorian'
   2.161+  type ; "scheduled", "clocked" ...
   2.162+  text
   2.163+  group-name
   2.164+  do-not-overlap-p ; make sure this block doesn't overlap with any other
   2.165+  )
   2.166+
   2.167+
   2.168+(defface org-timeline-block
   2.169+  '((t (:inherit secondary-selection)))
   2.170+  "Face used for printing blocks with time range information.
   2.171+
   2.172+These are blocks that are scheduled for specific time range or
   2.173+have an active timestamp with a range."
   2.174+  :group 'org-timeline-faces)
   2.175+
   2.176+(defface org-timeline-elapsed
   2.177+  '((t (:inherit region)))
   2.178+  "Face used for highlighting clocked items."
   2.179+  :group 'org-timeline-faces)
   2.180+
   2.181+(defface org-timeline-clocked
   2.182+  '((t (:inherit highlight)))
   2.183+  "Face used for printing clocked blocks.
   2.184+
   2.185+Clocked blocks appear in the agenda when `org-agenda-log-mode' is
   2.186+activated."
   2.187+  :group 'org-timeline-faces)
   2.188+
   2.189+(defface org-timeline-overlap
   2.190+  '((t (:background "dark red")))
   2.191+   "Face used for printing overlapping blocks."
   2.192+   :group 'org-timeline-faces)
   2.193+
   2.194+(defface org-timeline-next-block
   2.195+  '((t (:background "dark olive green")))
   2.196+   "Face used for printing the next block happening today.
   2.197+
   2.198+Used when `org-timeline-emphasize-next-block' is non-nil."
   2.199+   :group 'org-timeline-faces)
   2.200+
   2.201+
   2.202+(defmacro org-timeline-with-each-line (&rest body)
   2.203+  "Execute BODY on each line in buffer."
   2.204+  (declare (indent 0)
   2.205+           (debug (body)))
   2.206+  `(save-excursion
   2.207+     (goto-char (point-min))
   2.208+     ,@body
   2.209+     (while (= (forward-line) 0)
   2.210+       ,@body)))
   2.211+
   2.212+(defun org-timeline--get-face (type)
   2.213+  "Get the face with which to draw the current block, according to TYPE."
   2.214+  (--if-let (org-entry-get (org-get-at-bol 'org-marker) "TIMELINE_FACE" t)
   2.215+      (let ((read-face (car (read-from-string it))))
   2.216+        (if (stringp read-face)
   2.217+            (list :background read-face)
   2.218+          read-face))
   2.219+    (if (string= type "clock")
   2.220+        (list 'org-timeline-clocked)
   2.221+      (list 'org-timeline-block))))
   2.222+
   2.223+(defun org-timeline--get-block-text ()
   2.224+  "Get the text to print inside the current block."
   2.225+  (let ((item-marker (org-get-at-bol 'org-marker)))
   2.226+    (--if-let (org-entry-get item-marker "TIMELINE_TEXT" t)
   2.227+        it
   2.228+       (with-current-buffer (marker-buffer item-marker)
   2.229+        (save-excursion
   2.230+          (goto-char item-marker)
   2.231+          (outline-previous-heading)
   2.232+          (org-element-property :raw-value (org-element-context)))))))
   2.233+
   2.234+(defun org-timeline--get-group-name (type)
   2.235+  "Get the current block's 'group-name' according to TYPE.
   2.236+
   2.237+The first three chars will be printed at the beginning of the block's line."
   2.238+  (--if-let (org-entry-get (org-get-at-bol 'org-marker) "TIMELINE_GROUP" t)
   2.239+      (if (< (length it) 3)
   2.240+          (concat (substring "   " 0 (- 3 (length it))) it)
   2.241+        (substring it 0 3))
   2.242+    (if (and (string= type "clock") org-timeline-dedicated-clocked-line)
   2.243+        "  $"
   2.244+      "   ")))
   2.245+
   2.246+(defun org-timeline--get-do-not-overlap (type)
   2.247+  "Whether the current block is allowed to  overlap in the timeline according to TYPE."
   2.248+  (--if-let (org-entry-get (org-get-at-bol 'org-marker) "TIMELINE_DO_NOT_OVERLAP" t)
   2.249+      it
   2.250+    (if (and (not (string= type "clock")) org-timeline-overlap-in-new-line)
   2.251+        t
   2.252+      nil)))
   2.253+
   2.254+(defun org-timeline--overlapping-at-point (task)
   2.255+  "List of points where an already drawn blocks would overlap with TASK."
   2.256+  (save-excursion
   2.257+    (let (overlap-points)
   2.258+      (goto-char (+ (line-beginning-position) (org-timeline-task-offset-beg task)))
   2.259+      (while (and (<= (point) (+ (line-beginning-position) (org-timeline-task-offset-end task)))
   2.260+                 (< (point) (point-max)))
   2.261+        (when (get-text-property (point) 'org-timeline-occupied)
   2.262+          (push (point) overlap-points))
   2.263+        (forward-char))
   2.264+      overlap-points)))
   2.265+
   2.266+(defun org-timeline--new-overlap-line-required-at-point-p (task)
   2.267+  "Whether a new overlap line needs to be created to insert TASK."
   2.268+  (let* ((overlapping (org-timeline--overlapping-at-point task))
   2.269+         (overlapping-blocks-that-do-not-overlap
   2.270+          (delq nil (mapcar (lambda (point) (get-text-property point 'org-timeline-do-not-overlap)) overlapping))))
   2.271+    (and (not (eq overlapping nil))
   2.272+         (or (org-timeline-task-do-not-overlap-p task)
   2.273+             (not (eq overlapping-blocks-that-do-not-overlap nil))))))
   2.274+
   2.275+(defun org-timeline--add-elapsed-face (string)
   2.276+  "Add `org-timeline-elapsed' to STRING's elapsed portion.
   2.277+
   2.278+Return new copy of STRING."
   2.279+  (let* ((string-copy (copy-sequence string))
   2.280+         (start-offset (* org-timeline-beginning-of-day-hour 60))
   2.281+         (current-time (+ (* 60 (string-to-number (format-time-string "%H")))
   2.282+                          (string-to-number (format-time-string "%M"))))
   2.283+         (current-offset (/ (- current-time start-offset) 10)))
   2.284+    (when (< 0 current-offset)
   2.285+      (put-text-property 0 (+ 1 current-offset) 'font-lock-face (list 'org-timeline-elapsed) string-copy))
   2.286+    string-copy))
   2.287+
   2.288+(defun org-timeline--kill-info ()
   2.289+  "Kill the info line."
   2.290+  (save-excursion
   2.291+    (goto-line org-timeline-first-line-in-agenda-buffer)
   2.292+    (while (and (not (get-text-property (point) 'org-timeline-info-line))
   2.293+                (eq (forward-line) 0)))
   2.294+    (unless (eq (point) (point-max)) ; info line not found
   2.295+      (let ((inhibit-read-only t))
   2.296+        (kill-whole-line)))))
   2.297+
   2.298+(defun org-timeline--decorate-info (info)
   2.299+  "Make INFO string clickable."
   2.300+  (let ((info-keymap (make-sparse-keymap)))
   2.301+    (define-key info-keymap [mouse-1] 'org-agenda-goto)
   2.302+    (define-key info-keymap [mouse-2] 'org-find-file-at-mouse)
   2.303+    (propertize info 'keymap info-keymap
   2.304+                     'help-echo "mouse-1 jump to org file"
   2.305+                     'org-timeline-info-line t)))
   2.306+
   2.307+(defun org-timeline--draw-new-info (win info)
   2.308+  "Displays INFO about a hovered block.
   2.309+
   2.310+WIN is the agenda buffer's window."
   2.311+  (unless (eq info org-timeline-current-info) ; prevents flickering
   2.312+    (setq org-timeline-current-info info)
   2.313+    (save-window-excursion
   2.314+      (save-excursion
   2.315+        (select-window win) ; because one can hover blocks without being in the agenda window.
   2.316+        (org-timeline--kill-info)
   2.317+        (goto-line org-timeline-first-line-in-agenda-buffer)
   2.318+        (forward-line (- org-timeline-height 2))
   2.319+        (let ((inhibit-read-only t))
   2.320+          (insert (org-timeline--decorate-info info) "\n"))))))
   2.321+
   2.322+(defun org-timeline--move-to-task-in-agenda-buffer ()
   2.323+  "Move to a block's correponding task in the agenda buffer."
   2.324+  (interactive)
   2.325+   (let ((line (get-text-property (point) 'org-timeline-task-line)))
   2.326+     (when org-timeline-prepend
   2.327+       (setq line (+ line org-timeline-height -1)))
   2.328+     (goto-line line)
   2.329+     (search-forward (get-text-property (point) 'time)))) ; makes point more visible to user.
   2.330+
   2.331+(defun org-timeline--list-tasks ()
   2.332+  "Build the list of tasks to display."
   2.333+  (let* ((tasks nil)
   2.334+         (id 0)
   2.335+         (start-offset (* org-timeline-beginning-of-day-hour 60))
   2.336+         (current-time (+ (* 60 (string-to-number (format-time-string "%H")))
   2.337+                          (string-to-number (format-time-string "%M")))))
   2.338+    (org-timeline-with-each-line
   2.339+      (-when-let* ((time-of-day (org-get-at-bol 'time-of-day))
   2.340+                   (marker (org-get-at-bol 'org-marker))
   2.341+                   (type (org-get-at-bol 'type))
   2.342+                   (duration (or (org-get-at-bol 'duration)
   2.343+				 org-timeline-default-duration)))
   2.344+        (when (member type (list "past-scheduled" "scheduled" "clock" "timestamp"))
   2.345+          (when (and (numberp duration)
   2.346+                     (< duration 0))
   2.347+            (cl-incf duration 1440))
   2.348+          (let* ((hour (/ time-of-day 100))
   2.349+                 (minute (mod time-of-day 100))
   2.350+                 (beg (+ (* hour 60) minute))
   2.351+                 (end (round (+ beg duration))))
   2.352+	    (setq beg (max beg start-offset))
   2.353+            (setq end (min end (+ start-offset (* 24 60))))
   2.354+            (setq duration (- end beg))
   2.355+            (when (eq end (* 24 60)) (cl-incf end -1)) ; FIXME fixes a bug that shouldn't happen (crash when events end at midnight).
   2.356+            (when (and (>= end start-offset)
   2.357+                       (<= beg (+ start-offset (* 24 60)))
   2.358+                       (or org-timeline-show-clocked
   2.359+                           (not (string= type "clock"))))
   2.360+              (push (make-org-timeline-task
   2.361+                     :id id
   2.362+                     :beg beg
   2.363+                     :end end
   2.364+                     :offset-beg (+ 5 (- (/ beg 10) (* 6 org-timeline-beginning-of-day-hour)))
   2.365+                     :offset-end (+ 5 (- (/ end 10) (* 6 org-timeline-beginning-of-day-hour)))
   2.366+                     :info (buffer-substring (line-beginning-position) (line-end-position))
   2.367+                     :line-in-agenda-buffer (line-number-at-pos)
   2.368+                     :face (org-timeline--get-face type)
   2.369+                     :day (org-get-at-bol 'day)
   2.370+                     :type type
   2.371+                     :text (org-timeline--get-block-text)
   2.372+                     :group-name (org-timeline--get-group-name type)
   2.373+                     :do-not-overlap-p (org-timeline--get-do-not-overlap type)
   2.374+                     )
   2.375+                    tasks)
   2.376+              (cl-incf id))))))
   2.377+    ;; find the next task
   2.378+    (setq org-timeline-next-task nil)
   2.379+    (dolist (task tasks)
   2.380+      (let* ((beg (org-timeline-task-beg task))
   2.381+             (end (org-timeline-task-end task))
   2.382+             (today (calendar-absolute-from-gregorian (calendar-current-date)))
   2.383+             (is-today (eq today (org-timeline-task-day task)))
   2.384+             (is-now (and (<= beg current-time)
   2.385+                          (>= end current-time)))
   2.386+             (is-after (> beg current-time))
   2.387+             (is-closer-to-now (and is-after
   2.388+                                    (or (eq org-timeline-next-task nil)
   2.389+                                        (< beg (org-timeline-task-beg org-timeline-next-task))))))
   2.390+        (when (and is-today (or is-now is-closer-to-now))
   2.391+          (setq org-timeline-next-task task))))
   2.392+    ;; change the next task's face
   2.393+    (when (and org-timeline-emphasize-next-block
   2.394+               org-timeline-next-task)
   2.395+      (dolist (task tasks)
   2.396+        (when (eq (org-timeline-task-id task) (org-timeline-task-id org-timeline-next-task))
   2.397+          (setf (org-timeline-task-face task) (list 'org-timeline-next-block)))))
   2.398+  (nreverse tasks)))
   2.399+
   2.400+(defun org-timeline--goto-block-position (task)
   2.401+  "Go to TASK's block's line and position cursor in line...
   2.402+
   2.403+Return t if this task will overlap another one when inserted."
   2.404+  (let* ((slotline (org-timeline--add-elapsed-face org-timeline-slotline))
   2.405+         (offset-beg (org-timeline-task-offset-beg task))
   2.406+         (offset-end (org-timeline-task-offset-end task))
   2.407+         (day (org-timeline-task-day task))
   2.408+         (group-name (org-timeline-task-group-name task))
   2.409+         (do-not-overlap (org-timeline-task-do-not-overlap-p task)))
   2.410+    (goto-char 1)
   2.411+    (while (and (not (eq (get-text-property (point) 'org-timeline-day) day))
   2.412+                (not (eq (forward-line) 1))))
   2.413+    (unless (eq (get-text-property (point) 'org-timeline-day) day)
   2.414+      (insert (concat "\n" ; creating the necessary lines, up to the current task's day
   2.415+                      (mapconcat (lambda (line-day)
   2.416+                                   (propertize (concat (calendar-day-name (mod line-day 7) t t) ; found in https://github.com/deopurkar/org-timeline
   2.417+                                                       " "
   2.418+                                                       slotline)
   2.419+                                               'org-timeline-day line-day 'org-timeline-group-name "   "))
   2.420+                                 (if-let ((last-day (get-text-property (line-beginning-position) 'org-timeline-day)))
   2.421+                                     (number-sequence (+ 1 last-day) day)
   2.422+                                   (list day))
   2.423+                                 "\n"))))
   2.424+    ;; cursor is now at beginning of the task's day's first line
   2.425+    (while (and (not (string= (get-text-property (point) 'org-timeline-group-name) group-name))
   2.426+                (eq (get-text-property (point) 'org-timeline-day) day))
   2.427+      (forward-line))
   2.428+    (unless (string= (-if-let (group-here (get-text-property (point) 'org-timeline-group-name)) group-here "   ") group-name)
   2.429+      (when (not (eq (line-end-position) (point-max))) (forward-line -1))
   2.430+      (goto-char (line-end-position))
   2.431+      (insert "\n"
   2.432+              (propertize (concat group-name " " slotline) 'org-timeline-day day 'org-timeline-group-name group-name)))
   2.433+    ;; cursor is now at beginning of the task's group's first line
   2.434+    (let ((new-overlap-line-required-flag (org-timeline--new-overlap-line-required-at-point-p task)))
   2.435+      (while (and (org-timeline--new-overlap-line-required-at-point-p task)
   2.436+                  (eq (get-text-property (point) 'org-timeline-day) day)
   2.437+                  (eq (get-text-property (point) 'org-timeline-group-name) group-name)
   2.438+                  (not (eq (line-end-position) (point-max))))
   2.439+        (setq new-overlap-line-required-flag t)
   2.440+        (forward-line))
   2.441+      (let ((decorated-slotline (propertize (concat "   " " " slotline)
   2.442+                                            'org-timeline-day day
   2.443+                                            'org-timeline-group-name group-name)))
   2.444+        (when new-overlap-line-required-flag
   2.445+          (end-of-line)
   2.446+          (insert "\n" decorated-slotline))))
   2.447+    ;; cursor is now placed on the right line, at the right position.
   2.448+    (goto-char (+ (line-beginning-position) offset-beg))))
   2.449+
   2.450+(defun org-timeline--make-basic-block (task)
   2.451+  "Make TASK's block and return it as a propertized string.
   2.452+
   2.453+This does not take the block's context (e.g. overlap) into account."
   2.454+  (let* ((blank-block (mapconcat 'not (number-sequence 1 24) "      "))
   2.455+         (id (org-timeline-task-id task))
   2.456+         (offset-beg (org-timeline-task-offset-beg task))
   2.457+         (offset-end (org-timeline-task-offset-end task))
   2.458+         (info (org-timeline-task-info task))
   2.459+         (face (org-timeline-task-face task))
   2.460+         (line (org-timeline-task-line-in-agenda-buffer task))
   2.461+         (group-name (org-timeline-task-group-name task))
   2.462+         (do-not-overlap (org-timeline-task-do-not-overlap-p task))
   2.463+         (move-to-task-map '(keymap mouse-1 . org-timeline--move-to-task-in-agenda-buffer))
   2.464+         (block-length (- offset-end offset-beg))
   2.465+         (props (list 'font-lock-face face
   2.466+                      'org-timeline-occupied t
   2.467+                      'org-timeline-do-not-overlap do-not-overlap
   2.468+                      'org-timeline-task-id id
   2.469+                      'org-timeline-group-name group-name
   2.470+                      'mouse-face '(:highlight t :box t)
   2.471+                      'keymap move-to-task-map
   2.472+                      'task-info info
   2.473+                      'help-echo (lambda (w obj pos) ; called on block hover
   2.474+                                   (org-timeline--draw-new-info w info)
   2.475+                                   info)
   2.476+                      'org-timeline-task-line line))
   2.477+         (title (concat org-timeline-insert-before-text
   2.478+                        (org-timeline-task-text task)
   2.479+                        blank-block))
   2.480+         (block (if org-timeline-show-text-in-blocks
   2.481+                    title
   2.482+                  blank-block)))
   2.483+    (add-text-properties 0 block-length props block)
   2.484+    (substring block 0 block-length)))
   2.485+
   2.486+(defun org-timeline--make-and-insert-block (task)
   2.487+  "Insert the TASK's block at the right position in the timeline.
   2.488+
   2.489+Changes the block's face according to context."
   2.490+  (org-timeline--goto-block-position task)
   2.491+  (let ((overlapp (not (eq (org-timeline--overlapping-at-point task) nil)))
   2.492+        (is-next (if (not (eq org-timeline-next-task nil))
   2.493+                     (eq (org-timeline-task-id task) (org-timeline-task-id org-timeline-next-task))
   2.494+                   nil))
   2.495+        (block (org-timeline--make-basic-block task)))
   2.496+    (when overlapp (setq block (propertize block 'font-lock-face (list 'org-timeline-overlap))))
   2.497+    (when is-next (setq block (propertize block 'font-lock-face (list 'org-timeline-next-block))))
   2.498+    (unless (get-text-property (- (point) 1) 'org-timeline-overline)
   2.499+      (add-text-properties 0 (length block)
   2.500+                           (list 'org-timeline-overline t
   2.501+                                 'font-lock-face (append (get-text-property 0 'font-lock-face block) '((:overline t)))
   2.502+                                 'mouse-face (append (get-text-property 0 'mouse-face block) '((:overline t))))
   2.503+                           block))
   2.504+    (setq block (substring block 0 (min (length block) (- (line-end-position) (point)))))
   2.505+    (delete-char (length block))
   2.506+    (insert block)))
   2.507+
   2.508+(defun org-timeline--merge-for-24h-cycle ()
   2.509+  "Kill elapsed columns in day's line according to `org-timeline-keep-elapsed'.
   2.510+
   2.511+Move tomorrow's line to the right of today's line, to show a complete 24h cycle.
   2.512+See the documentation of `org-timeline-keep-elapsed' for more information."
   2.513+  ;; FIXME: quite hacky. This should probably be done directly when making the tasks list,
   2.514+  ;; maybe by making all those events happen the same fake '0' day and change the offsets accordingly.
   2.515+  (let* ((today (calendar-absolute-from-gregorian (calendar-current-date)))
   2.516+         (current-hour (string-to-number (format-time-string "%H")))
   2.517+         (current-time (+ (* 60 current-hour)
   2.518+                          (string-to-number (format-time-string "%M"))))
   2.519+         (elapsed-hours (- (floor (/ current-time 60)) org-timeline-beginning-of-day-hour))
   2.520+         (number-of-columns-tomorrow (max 0 (- elapsed-hours org-timeline-keep-elapsed)))
   2.521+         (number-of-columns-today (- 24 number-of-columns-tomorrow))
   2.522+         (hourline-piece (delete-and-extract-region 6 (+ 6 (* 6 number-of-columns-tomorrow))))
   2.523+         (today-line-pieces nil)
   2.524+         (tomorrow-line-pieces nil)
   2.525+         (cycle-offset (* 6 (- (max org-timeline-beginning-of-day-hour (- current-hour org-timeline-keep-elapsed)) org-timeline-beginning-of-day-hour)))
   2.526+         (blank-today-line-piece (concat "    " (substring (org-timeline--add-elapsed-face org-timeline-slotline)
   2.527+                                                           cycle-offset
   2.528+                                                           (+ cycle-offset (* 6 number-of-columns-today)))
   2.529+                                         "|"))
   2.530+         (blank-tomorrow-line-piece (concat "     " (substring org-timeline-slotline 0 (* 6 number-of-columns-tomorrow)))))
   2.531+    (goto-char 1)
   2.532+    (goto-char (line-end-position))
   2.533+    (insert hourline-piece)
   2.534+    ;; build (today|tomorrow)-line-pieces lists.
   2.535+    (while (not (eq (line-end-position) (point-max)))
   2.536+      (forward-line)
   2.537+      (let* ((lbeg (line-beginning-position))
   2.538+             (lend (line-end-position))
   2.539+             (today-portion (concat (buffer-substring lbeg (+ lbeg 4))
   2.540+                                    (buffer-substring (- lend (* 6 number-of-columns-today) 1) lend)))
   2.541+             (tomorrow-portion (buffer-substring (+ 5 lbeg) (+ 5 lbeg (* 6 number-of-columns-tomorrow)))))
   2.542+        (when (eq (get-text-property lbeg 'org-timeline-day) today)
   2.543+          (setq today-line-pieces (append today-line-pieces (list today-portion))))
   2.544+        (when (eq (get-text-property lbeg 'org-timeline-day) (+ today 1))
   2.545+          (setq tomorrow-line-pieces (append tomorrow-line-pieces (list tomorrow-portion))))))
   2.546+    ;; handle groups and balance lines
   2.547+    ;; FIXME: not efficient, doesn't jump once group done
   2.548+    ;; (print "today")
   2.549+    ;; (dolist (line today-line-pieces) (print line))
   2.550+    ;; (print "tomorrow")
   2.551+    ;; (dolist (line tomorrow-line-pieces) (print line))
   2.552+    (let (groups-handled)
   2.553+      (dotimes (i (length today-line-pieces))
   2.554+        (let* ((group-handled (get-text-property 0 'org-timeline-group-name (seq-elt today-line-pieces i)))
   2.555+               (group-handled-p (lambda (piece) (string= (get-text-property 1 'org-timeline-group-name piece) group-handled)))
   2.556+               (prev-pieces-today (seq-take today-line-pieces i))
   2.557+               (next-pieces-today (seq-drop today-line-pieces i))
   2.558+               (same-group-pieces-today (seq-filter group-handled-p next-pieces-today))
   2.559+               (rest-of-pieces-today    (seq-remove group-handled-p next-pieces-today))
   2.560+               (prev-pieces-tomorrow (seq-take tomorrow-line-pieces i))
   2.561+               (next-pieces-tomorrow (seq-drop tomorrow-line-pieces i))
   2.562+               (same-group-pieces-tomorrow (seq-filter group-handled-p next-pieces-tomorrow))
   2.563+               (rest-of-pieces-tomorrow    (seq-remove group-handled-p next-pieces-tomorrow)))
   2.564+          ;; balance groups
   2.565+          (let* ((line-diff (- (length same-group-pieces-tomorrow) (length same-group-pieces-today)))
   2.566+                 (number-of-blank-lines-to-add-today (max 0 line-diff))
   2.567+                 (number-of-blank-lines-to-add-tomorrow (max 0 (- 0 line-diff))))
   2.568+            (dotimes (n number-of-blank-lines-to-add-today)
   2.569+              (setq same-group-pieces-today (append same-group-pieces-today (list blank-today-line-piece))))
   2.570+            (dotimes (n number-of-blank-lines-to-add-tomorrow)
   2.571+              (setq same-group-pieces-tomorrow (append same-group-pieces-tomorrow (list blank-tomorrow-line-piece)))))
   2.572+          ;; rebuild the pieces lists
   2.573+          (setq today-line-pieces (append prev-pieces-today same-group-pieces-today rest-of-pieces-today))
   2.574+          (setq tomorrow-line-pieces (append prev-pieces-tomorrow same-group-pieces-tomorrow rest-of-pieces-tomorrow))))
   2.575+        (let* ((unhandled-groups-tomorrow (seq-drop tomorrow-line-pieces (length today-line-pieces))))
   2.576+          (dolist (piece unhandled-groups-tomorrow)
   2.577+            (if (member (get-text-property 0 'org-timeline-group-name piece) groups-handled)
   2.578+                (setq today-line-pieces (append today-line-pieces (list blank-today-line-piece)))
   2.579+              (setq today-line-pieces (append today-line-pieces (list (concat (get-text-property 0 'org-timeline-group-name piece)
   2.580+                                                                              (substring blank-today-line-piece 3 nil))))))
   2.581+            (push (get-text-property 0 'org-timeline-group-name piece) groups-handled))))
   2.582+    ;; (print "today")
   2.583+    ;; (dolist (line today-line-pieces) (print line))
   2.584+    ;; (print "tomorrow")
   2.585+    ;; (dolist (line tomorrow-line-pieces) (print line))
   2.586+    ;; insert them
   2.587+    (goto-char 1)
   2.588+    (let ((hourline (buffer-substring 1 (line-end-position))))
   2.589+      (delete-region (point-min) (point-max))
   2.590+      (insert hourline))
   2.591+    (dolist (piece today-line-pieces)
   2.592+      (insert "\n" piece))
   2.593+    (goto-line 2)
   2.594+    (dolist (piece tomorrow-line-pieces)
   2.595+      (goto-char (line-end-position))
   2.596+      (insert piece)
   2.597+      (forward-line))
   2.598+    ;; remove elapsed face from tomorrow lines
   2.599+    (goto-char 1)
   2.600+    (put-text-property (+ 5  (* 6 number-of-columns-today)) (line-end-position) 'face nil)
   2.601+    (while (and (eq (forward-line) 0)
   2.602+                (not (eq (point) (point-max))))
   2.603+      (forward-char (+ 5 (* 6 number-of-columns-today)))
   2.604+      (dotimes (i (- (line-end-position) (point)))
   2.605+        (when (not (get-text-property (point) 'org-timeline-occupied))
   2.606+          (put-text-property (point) (+ (point) 1) 'face nil))
   2.607+        (forward-char)))))
   2.608+
   2.609+;; Some ideas for the the generation of the timeline were inspired by the
   2.610+;; forked repo: https://github.com/deopurkar/org-timeline.
   2.611+(defun org-timeline--generate-timeline ()
   2.612+  "Generate the timeline string that will represent current agenda view."
   2.613+  (let* ((hourline (concat "    "
   2.614+                           (org-timeline--add-elapsed-face
   2.615+                            (concat "|"
   2.616+                                    (mapconcat (lambda (x) (format "%02d:00" (mod x 24)))
   2.617+                                               (number-sequence org-timeline-beginning-of-day-hour (+ org-timeline-beginning-of-day-hour 23))
   2.618+                                               "|")
   2.619+                                    "|"))))
   2.620+         (tasks (org-timeline--list-tasks))
   2.621+         (today (calendar-absolute-from-gregorian (calendar-current-date)))
   2.622+         (today-onlyp (eq 0 (length (delq nil (mapcar (lambda (task) (if (eq (org-timeline-task-day task) today) nil task)) tasks)))))
   2.623+         (today-or-tomorrow-only-p (eq 0 (length (delq nil (mapcar (lambda (task) (if (member (org-timeline-task-day task) `(,today ,(+ today 1))) nil task)) tasks))))))
   2.624+    (with-temp-buffer
   2.625+      (insert hourline)
   2.626+      (dolist (task tasks)
   2.627+        ;; (print (buffer-substring (point-min) (point-max)))
   2.628+        (org-timeline--make-and-insert-block task))
   2.629+      ;; (print (buffer-substring (point-min) (point-max)))
   2.630+      (when (and (>= org-timeline-keep-elapsed 0)
   2.631+                 today-or-tomorrow-only-p
   2.632+                 (> (length tasks) 0))
   2.633+        (org-timeline--merge-for-24h-cycle))
   2.634+      ;; display the next block's info
   2.635+      (goto-char (point-max))
   2.636+      (unless (eq (length tasks) 0)
   2.637+        (insert "\n"
   2.638+                (if (eq org-timeline-next-task nil)
   2.639+                    (propertize "  no incoming event" 'org-timeline-info-line t)
   2.640+                  (org-timeline--decorate-info (org-timeline-task-info org-timeline-next-task)))))
   2.641+      (buffer-string))))
   2.642+
   2.643+;;;###autoload
   2.644+(defun org-timeline-insert-timeline ()
   2.645+  "Insert graphical timeline into agenda buffer."
   2.646+  (unless (buffer-narrowed-p)
   2.647+    (goto-char (point-min))
   2.648+    (unless org-timeline-prepend
   2.649+      (while (and (eq (get-text-property (line-beginning-position) 'org-agenda-type) 'agenda)
   2.650+                  (not (eobp)))
   2.651+        (forward-line)))
   2.652+    (forward-line)
   2.653+    (let ((inhibit-read-only t))
   2.654+      (setq org-timeline-first-line-in-agenda-buffer (line-number-at-pos))
   2.655+      (insert (propertize (concat (make-string (window-width) ?─)) 'face 'org-time-grid) "\n")
   2.656+      (insert (org-timeline--generate-timeline))
   2.657+      (insert (propertize (concat "\n" (make-string (window-width) ?─)) 'face 'org-time-grid 'org-timeline-end t) "\n")
   2.658+      (setq org-timeline-height (- (line-number-at-pos) org-timeline-first-line-in-agenda-buffer)))
   2.659+    ;; enable `font-lock-mode' in agenda view to display the "chart"
   2.660+    (font-lock-mode)))
   2.661+
   2.662+(provide 'org-timeline)
   2.663+;;; org-timeline.el ends here
     3.1--- a/.stumpwm.d/init.lisp	Fri Aug 23 19:12:13 2024 -0400
     3.2+++ b/.stumpwm.d/init.lisp	Fri Aug 30 17:07:30 2024 -0400
     3.3@@ -4,6 +4,9 @@
     3.4 
     3.5 (stumpwm:set-prefix-key (kbd "s-SPC"))
     3.6 
     3.7+(ignore-errors
     3.8+ (ql:quickload '(:std :core :prelude :user)))
     3.9+
    3.10 (defcommand load-std () ()
    3.11   (ql:quickload :std))
    3.12 
    3.13@@ -14,7 +17,8 @@
    3.14   (ql:quickload :core))
    3.15 
    3.16 (defcommand load-user () ()
    3.17-  (ql:quickload :user))
    3.18+  (ql:quickload :user)
    3.19+  (in-package :user))
    3.20 
    3.21 (setq *mouse-focus-policy*    :sloppy
    3.22       *float-window-modifier* :SUPER
    3.23@@ -35,7 +39,20 @@
    3.24 (unless swm-golden-ratio:*golden-ratio-on*
    3.25   (swm-golden-ratio:toggle-golden-ratio))
    3.26 
    3.27-(load-module "stumptray")
    3.28+;; (load-module "stumptray")
    3.29+(load-module "cpu")
    3.30+(load-module "hostname")
    3.31+(load-module "mpd")
    3.32+(load-module "mem")
    3.33+(ql:quickload '(:cl-diskspace :cl-mount-info))
    3.34+(load-module "disk")
    3.35+(setq *mode-line-highlight-template* "«~A»")
    3.36+(setf *screen-mode-line-format* (list "[^B%n^b] %W^> %C | %M | %l | %D | %h | %d"))
    3.37+
    3.38+(ql:quickload :xml-emitter)
    3.39+(ql:quickload :dbus)
    3.40+(load-module "notify")
    3.41+(notify:notify-server-toggle)
    3.42 
    3.43 (set-fg-color "#ffffff")
    3.44 (set-bg-color "#000000")
    3.45@@ -61,22 +78,35 @@
    3.46                      "#FEFEFE"))    ; 7 white
    3.47 
    3.48 (setf *window-format* "%m%n%s%c")
    3.49-(setf *screen-mode-line-format* (list "[^B%n^b] %W^>%d"))
    3.50 (set-normal-gravity :center)
    3.51 (set-maxsize-gravity :center)
    3.52 (set-transient-gravity :center)
    3.53-(setf *time-modeline-string* "%a %b %e %k:%M")
    3.54+(setf *time-modeline-string* "%F %H:%M")
    3.55+(setf *group-format* "%t")
    3.56+(setq *mode-line-timeout* 4)
    3.57 
    3.58-(setq *mode-line-timeout* 4)(
    3.59-which-key-mode)
    3.60+(which-key-mode)
    3.61 
    3.62 (when *initializing*
    3.63+  (grename "*MAIN*")
    3.64+  (gnewbg "*ORG*")
    3.65+  (gnewbg "*MEDIA*")
    3.66+  (gnewbg "*SCRATCH*")
    3.67   (run-shell-command "sh ~/.fehbg")
    3.68   (when (equal (machine-instance) "zor")
    3.69     (run-shell-command "sh ~/.screenlayout/default.sh"))
    3.70   (dolist (h (screen-heads (current-screen)))
    3.71     (enable-mode-line (current-screen) h t)))
    3.72 
    3.73+(clear-window-placement-rules)
    3.74+
    3.75+(define-frame-preference "*MAIN*" (nil t t :class "Tiling"))
    3.76+(define-frame-preference "*ORG*" (nil t t :class "Tiling"))
    3.77+(define-frame-preference "*MEDIA*" (nil t t :class "Floating"))
    3.78+(define-frame-preference "*SCRATCH*" (nil t t :class "Tiling"))
    3.79+
    3.80+(setf *dynamic-group-master-split-ratio* 1/2)
    3.81+
    3.82 (defcommand term (&optional program) ()
    3.83   (sb-thread:make-thread
    3.84    (lambda ()
    3.85@@ -89,15 +119,26 @@
    3.86    (lambda ()
    3.87      (run-shell-command "blueberry"))))
    3.88 
    3.89+(defcommand firefox () ()
    3.90+  "Run or raise Firefox."
    3.91+  (sb-thread:make-thread
    3.92+   (lambda () (run-or-raise "firefox" '(:class "Firefox") t nil))))
    3.93+
    3.94 (defcommand chromium () ()
    3.95   (sb-thread:make-thread
    3.96    (lambda ()
    3.97-     (run-shell-command "chromium"))))
    3.98+     (run-or-raise "chromium" '(:class "Chromium") t nil))))
    3.99 
   3.100 (defcommand emacsclient () ()
   3.101   (run-shell-command "emacsclient -c -a="))
   3.102 
   3.103-(define-key *root-map* (kbd "c") "term")
   3.104+(defcommand homer () ()
   3.105+  (run-shell-command "homer"))
   3.106+
   3.107+(defcommand skel () ()
   3.108+  (run-shell-command "skel"))
   3.109+
   3.110+(define-key *root-map* (kbd "t") "term")
   3.111 (define-key *root-map* (kbd "e") "emacsclient")
   3.112 (define-key *root-map* (kbd "C-e") "emacs")
   3.113 (define-key *root-map* (kbd "s-w") "chromium")