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")