Commit df57299294a9
Changed files (2)
dots
config
emacs
site-lisp
dots/config/emacs/site-lisp/org-kanban.el
@@ -0,0 +1,894 @@
+;;; org-kanban.el --- Kanban board view for org-mode TODOs -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026 Vincent Demeester
+
+;; Author: Vincent Demeester <vincent@sbr.pm>
+;; Keywords: org, kanban, productivity
+;; Version: 0.1.0
+;; Package-Requires: ((emacs "29.1") (org-ql "0.8"))
+
+;;; Commentary:
+
+;; Interactive kanban board that renders org-mode TODOs as cards in
+;; columns based on their TODO state. Cards can be moved between
+;; columns (changing their state) with simple keybindings.
+;;
+;; Uses org-ql for querying and org-mode API for state changes.
+;; Data source is your existing todos.org file.
+;;
+;; Keybindings in org-kanban buffers:
+;; j / n / ↓ - next card down in column
+;; k / p / ↑ - previous card up in column
+;; l / → - next column
+;; h / ← - previous column
+;; > / L - move card to next state
+;; < / H - move card to previous state
+;; RET - jump to heading in org file
+;; v / SPC - preview card in side window (toggle)
+;; f - filter by section
+;; F - clear filters
+;; D - toggle DONE/CANX visibility
+;; g - refresh board
+;; q - quit
+;; TAB - cycle card detail
+;;
+;; Interactive commands:
+;; M-x org-kanban - open kanban board
+;; M-x org-kanban-work - board filtered to Work section
+
+;;; Code:
+
+(require 'org)
+(require 'org-ql)
+(require 'cl-lib)
+
+;;; Customization
+
+(defgroup org-kanban nil
+ "Kanban board view for org-mode TODOs."
+ :group 'org
+ :prefix "org-kanban-")
+
+(defcustom org-kanban-file (expand-file-name "~/desktop/org/todos.org")
+ "Path to the org file to display as a kanban board."
+ :type 'file
+ :group 'org-kanban)
+
+(defcustom org-kanban-columns '("TODO" "NEXT" "STRT" "WAIT")
+ "TODO states to display as columns (left to right).
+DONE and CANX are toggled with `D'."
+ :type '(repeat string)
+ :group 'org-kanban)
+
+(defcustom org-kanban-done-columns '("DONE" "CANX")
+ "Completed states, hidden by default. Toggle with `D'."
+ :type '(repeat string)
+ :group 'org-kanban)
+
+(defcustom org-kanban-state-order '("TODO" "NEXT" "STRT" "WAIT" "DONE" "CANX")
+ "Order of states for moving cards left/right."
+ :type '(repeat string)
+ :group 'org-kanban)
+
+(defcustom org-kanban-column-width 30
+ "Width of each column in characters."
+ :type 'integer
+ :group 'org-kanban)
+
+(defcustom org-kanban-max-cards nil
+ "Maximum number of cards per column. Nil means no limit."
+ :type '(choice (const :tag "No limit" nil) integer)
+ :group 'org-kanban)
+
+(defcustom org-kanban-level 2
+ "Org heading level to display as cards.
+2 means direct children of top-level sections."
+ :type 'integer
+ :group 'org-kanban)
+
+(defcustom org-kanban-open-in-tab t
+ "If non-nil, RET opens the heading in a new tab.
+If nil, opens in a new window via `pop-to-buffer'."
+ :type 'boolean
+ :group 'org-kanban)
+
+(defcustom org-kanban-sort 'priority
+ "Default sort order for cards within each column."
+ :type '(choice (const :tag "Priority (highest first)" priority)
+ (const :tag "Scheduled date (earliest first)" scheduled)
+ (const :tag "Deadline (earliest first)" deadline)
+ (const :tag "Alphabetical" alpha)
+ (const :tag "No sorting (file order)" none))
+ :group 'org-kanban)
+
+;;; Faces
+
+(defface org-kanban-column-header
+ '((t :inherit fixed-pitch :weight bold :underline t))
+ "Face for column headers."
+ :group 'org-kanban)
+
+(defface org-kanban-card
+ '((t :inherit default))
+ "Face for card text."
+ :group 'org-kanban)
+
+(defface org-kanban-card-selected
+ '((((class color) (background dark))
+ :background "#44475a" :extend t)
+ (((class color) (background light))
+ :background "#dde4ff" :extend t)
+ (t :inverse-video t :extend t))
+ "Face for the currently selected card."
+ :group 'org-kanban)
+
+(defface org-kanban-indicator
+ '((((background dark))
+ :foreground "#ff79c6" :weight bold)
+ (((background light))
+ :foreground "#a626a4" :weight bold))
+ "Face for the active card indicator."
+ :group 'org-kanban)
+
+(defface org-kanban-priority-1
+ '((t :foreground "#ff5555" :weight bold))
+ "Face for priority 1 (highest)."
+ :group 'org-kanban)
+
+(defface org-kanban-priority-2
+ '((t :foreground "#ffb86c" :weight bold))
+ "Face for priority 2."
+ :group 'org-kanban)
+
+(defface org-kanban-priority-3
+ '((t :foreground "#f1fa8c"))
+ "Face for priority 3."
+ :group 'org-kanban)
+
+(defface org-kanban-state-todo
+ '((t :foreground "#8be9fd"))
+ "Face for TODO state."
+ :group 'org-kanban)
+
+(defface org-kanban-state-next
+ '((t :foreground "#50fa7b" :weight bold))
+ "Face for NEXT state."
+ :group 'org-kanban)
+
+(defface org-kanban-state-strt
+ '((t :foreground "#ff79c6" :weight bold))
+ "Face for STRT state."
+ :group 'org-kanban)
+
+(defface org-kanban-state-wait
+ '((t :foreground "#ffb86c"))
+ "Face for WAIT state."
+ :group 'org-kanban)
+
+(defface org-kanban-state-done
+ '((t :foreground "#6272a4"))
+ "Face for DONE state."
+ :group 'org-kanban)
+
+(defface org-kanban-state-canx
+ '((t :foreground "#6272a4" :strike-through t))
+ "Face for CANX state."
+ :group 'org-kanban)
+
+(defface org-kanban-tag
+ '((t :inherit org-tag))
+ "Face for tags on cards."
+ :group 'org-kanban)
+
+(defface org-kanban-date
+ '((t :inherit org-date))
+ "Face for dates on cards."
+ :group 'org-kanban)
+
+(defface org-kanban-section-filter
+ '((t :inherit font-lock-keyword-face))
+ "Face for the active section filter indicator."
+ :group 'org-kanban)
+
+;;; Internal variables
+
+(defvar-local org-kanban--cards nil
+ "Alist of (STATE . cards) for current board.")
+
+(defvar-local org-kanban--show-done nil
+ "Whether to show DONE/CANX columns.")
+
+(defvar-local org-kanban--section-filter nil
+ "Current section filter, or nil for all.")
+
+(defvar-local org-kanban--selected-card nil
+ "Plist of the currently selected card (:heading :state :col :row).")
+
+(defvar-local org-kanban--card-positions nil
+ "Hash table mapping (col . row) to card plist.")
+
+(defvar-local org-kanban--selected-col nil
+ "Column index of the currently selected card.")
+
+(defvar-local org-kanban--selected-row nil
+ "Row index of the currently selected card.")
+
+(defvar-local org-kanban--sort nil
+ "Current sort order. Nil means use `org-kanban-sort' default.")
+
+;;; Data fetching
+
+(defun org-kanban--fetch-cards ()
+ "Fetch all TODO items from `org-kanban-file' using org-ql.
+Returns an alist of (STATE . list-of-card-plists)."
+ (let ((all-states (append org-kanban-columns
+ (when org-kanban--show-done
+ org-kanban-done-columns)))
+ (results '()))
+ (dolist (state all-states)
+ (let ((cards (org-ql-select org-kanban-file
+ `(and (todo ,state)
+ (level ,org-kanban-level)
+ ,@(when org-kanban--section-filter
+ `((ancestors
+ (and (level 1)
+ (heading ,org-kanban--section-filter))))))
+ :action (lambda ()
+ (let* ((element (org-element-at-point))
+ (priority-raw (org-element-property :priority element))
+ (priority-num (when priority-raw
+ (if (< priority-raw 10)
+ priority-raw ;; already a number (1-5)
+ (- priority-raw 48)))) ;; ASCII char (?1=49 -> 1)
+ (tags (mapcar #'substring-no-properties (org-get-tags nil t)))
+ (scheduled (org-entry-get nil "SCHEDULED"))
+ (deadline (org-entry-get nil "DEADLINE"))
+ (section (save-excursion
+ (while (> (org-current-level) 1)
+ (org-up-heading-safe))
+ (substring-no-properties (org-get-heading t t t t)))))
+ (list :heading (org-kanban--render-links
+ (substring-no-properties (org-get-heading t t t t)))
+ :state state
+ :priority priority-num
+ :tags tags
+ :scheduled scheduled
+ :deadline deadline
+ :section section
+ :marker (point-marker)))))))
+ (push (cons state (org-kanban--sort-cards cards)) results)))
+ (nreverse results)))
+
+(defun org-kanban--sort-cards (cards)
+ "Sort CARDS according to the current sort order."
+ (let ((order (or org-kanban--sort org-kanban-sort)))
+ (pcase order
+ ('none cards)
+ ('priority
+ (sort cards
+ (lambda (a b)
+ (let ((pa (or (plist-get a :priority) 99))
+ (pb (or (plist-get b :priority) 99)))
+ (< pa pb)))))
+ ('scheduled
+ (sort cards
+ (lambda (a b)
+ (let ((sa (or (plist-get a :scheduled) "9999"))
+ (sb (or (plist-get b :scheduled) "9999")))
+ (string< sa sb)))))
+ ('deadline
+ (sort cards
+ (lambda (a b)
+ (let ((da (or (plist-get a :deadline) "9999"))
+ (db (or (plist-get b :deadline) "9999")))
+ (string< da db)))))
+ ('alpha
+ (sort cards
+ (lambda (a b)
+ (string< (plist-get a :heading) (plist-get b :heading)))))
+ (_ cards))))
+
+;;; Text processing
+
+(defun org-kanban--render-links (str)
+ "Replace org links in STR with their description.
+\=[[url][desc]] becomes desc, [[url]] becomes url."
+ (let ((result str))
+ ;; [[target][description]] → description
+ (setq result (replace-regexp-in-string
+ "\\[\\[\\([^]]*\\)\\]\\[\\([^]]*\\)\\]\\]"
+ "\\2" result))
+ ;; [[target]] → target
+ (setq result (replace-regexp-in-string
+ "\\[\\[\\([^]]*\\)\\]\\]"
+ "\\1" result))
+ result))
+
+;;; Rendering
+
+(defun org-kanban--truncate (str width)
+ "Truncate STR to WIDTH display columns, adding ellipsis if needed."
+ (if (> (string-width str) width)
+ (concat (truncate-string-to-width str (- width 1)) "…")
+ str))
+
+(defun org-kanban--pad (str width)
+ "Pad STR to WIDTH display columns with spaces."
+ (let ((truncated (org-kanban--truncate str width)))
+ (concat truncated (make-string (max 0 (- width (string-width truncated))) ?\s))))
+
+(defun org-kanban--state-face (state)
+ "Return the face for STATE."
+ (pcase state
+ ("TODO" 'org-kanban-state-todo)
+ ("NEXT" 'org-kanban-state-next)
+ ("STRT" 'org-kanban-state-strt)
+ ("WAIT" 'org-kanban-state-wait)
+ ("DONE" 'org-kanban-state-done)
+ ("CANX" 'org-kanban-state-canx)
+ (_ 'default)))
+
+(defun org-kanban--priority-face (priority)
+ "Return the face for PRIORITY number."
+ (pcase priority
+ (1 'org-kanban-priority-1)
+ (2 'org-kanban-priority-2)
+ (3 'org-kanban-priority-3)
+ (_ nil)))
+
+(defun org-kanban--format-card-line1 (card width &optional selected)
+ "Format first line of CARD (heading) to fit WIDTH.
+If SELECTED is non-nil, prepend a visible indicator."
+ (let* ((indicator (if selected
+ (propertize "▶ " 'face 'org-kanban-indicator)
+ " "))
+ (inner-width (- width 2)) ;; reserve 2 chars for indicator
+ (heading (plist-get card :heading))
+ (priority (plist-get card :priority))
+ (prefix (if priority (format "[#%d] " priority) ""))
+ (avail (- inner-width (string-width prefix)))
+ (truncated (org-kanban--truncate heading avail))
+ (line (concat prefix truncated))
+ (result (org-kanban--pad line inner-width)))
+ ;; Apply priority face to prefix
+ (when (and priority (org-kanban--priority-face priority))
+ (put-text-property 0 (min (length prefix) (length result)) 'face
+ (org-kanban--priority-face priority) result))
+ (concat indicator result)))
+
+(defun org-kanban--format-card-line2 (card width &optional selected)
+ "Format second line of CARD (metadata) to fit WIDTH.
+If SELECTED is non-nil, prepend a continuation indicator."
+ (let* ((tags (plist-get card :tags))
+ (scheduled (plist-get card :scheduled))
+ (deadline (plist-get card :deadline))
+ (section (plist-get card :section))
+ (parts '()))
+ ;; Add date info
+ (when deadline
+ (push (propertize (format "⚑%s" (org-kanban--short-date deadline))
+ 'face 'org-kanban-date)
+ parts))
+ (when scheduled
+ (push (propertize (format "▸%s" (org-kanban--short-date scheduled))
+ 'face 'org-kanban-date)
+ parts))
+ ;; Add section
+ (when (and section (not org-kanban--section-filter))
+ (push (propertize (org-kanban--truncate section 10)
+ 'face 'org-kanban-section-filter)
+ parts))
+ ;; Add first tag
+ (when tags
+ (push (propertize (format ":%s:" (car tags))
+ 'face 'org-kanban-tag)
+ parts))
+ (let* ((indicator (if selected
+ (propertize "│ " 'face 'org-kanban-indicator)
+ " "))
+ (inner-width (- width 2))
+ (line (string-join (nreverse parts) " ")))
+ (concat indicator (org-kanban--pad line inner-width)))))
+
+(defun org-kanban--short-date (date-str)
+ "Extract short date from DATE-STR like '<2026-04-07 Tue>'."
+ (if (and date-str (string-match "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)" date-str))
+ (let ((date (match-string 1 date-str)))
+ (format "%s/%s" (substring date 5 7) (substring date 8 10)))
+ ""))
+
+(defun org-kanban--render ()
+ "Render the kanban board into the current buffer."
+ (let* ((inhibit-read-only t)
+ (columns (append org-kanban-columns
+ (when org-kanban--show-done
+ org-kanban-done-columns)))
+ (col-width org-kanban-column-width)
+ (separator "│")
+ (card-positions (make-hash-table :test 'equal))
+ ;; Calculate max rows
+ (max-rows (apply #'max 0
+ (mapcar (lambda (state)
+ (length (alist-get state org-kanban--cards
+ nil nil #'string=)))
+ columns))))
+ (erase-buffer)
+
+ ;; Title line
+ (insert (propertize " Org Kanban" 'face '(:inherit fixed-pitch :weight bold :height 1.3)))
+ (when org-kanban--section-filter
+ (insert " "
+ (propertize (format "⟨%s⟩" org-kanban--section-filter)
+ 'face 'org-kanban-section-filter)))
+ ;; Show current sort
+ (let ((sort-name (or org-kanban--sort org-kanban-sort)))
+ (unless (eq sort-name 'none)
+ (insert " "
+ (propertize (format "↕%s" sort-name) 'face 'shadow))))
+ (unless org-kanban--show-done
+ (insert " "
+ (propertize "(D to show done)" 'face 'shadow)))
+ (insert "\n\n")
+
+ ;; Column headers
+ (insert " ")
+ (dotimes (col-idx (length columns))
+ (let* ((state (nth col-idx columns))
+ (count (length (alist-get state org-kanban--cards nil nil #'string=)))
+ (header (format "%s (%d)" state count)))
+ (insert (propertize (org-kanban--pad header col-width)
+ 'face (list 'org-kanban-column-header
+ (org-kanban--state-face state))))
+ (when (< col-idx (1- (length columns)))
+ (insert " " separator " "))))
+ (insert "\n")
+
+ ;; Separator line
+ (insert " ")
+ (dotimes (col-idx (length columns))
+ (insert (make-string col-width ?─))
+ (when (< col-idx (1- (length columns)))
+ (insert "─┼─")))
+ (insert "\n")
+
+ ;; Card rows
+ (dotimes (row max-rows)
+ ;; Line 1: heading
+ (insert " ")
+ (dotimes (col-idx (length columns))
+ (let* ((state (nth col-idx columns))
+ (cards (alist-get state org-kanban--cards nil nil #'string=))
+ (card (nth row cards)))
+ (if card
+ (let* ((sel (and (eql col-idx org-kanban--selected-col)
+ (eql row org-kanban--selected-row)))
+ (start (point)))
+ (insert (org-kanban--format-card-line1 card col-width sel))
+ ;; Store card position
+ (puthash (cons col-idx row) card card-positions)
+ ;; Add text properties for navigation
+ (put-text-property start (point) 'org-kanban-card card)
+ (put-text-property start (point) 'org-kanban-col col-idx)
+ (put-text-property start (point) 'org-kanban-row row))
+ (insert (make-string col-width ?\s)))
+ (when (< col-idx (1- (length columns)))
+ (insert " " separator " "))))
+ (insert "\n")
+
+ ;; Line 2: metadata
+ (insert " ")
+ (dotimes (col-idx (length columns))
+ (let* ((state (nth col-idx columns))
+ (cards (alist-get state org-kanban--cards nil nil #'string=))
+ (card (nth row cards)))
+ (if card
+ (let* ((sel (and (eql col-idx org-kanban--selected-col)
+ (eql row org-kanban--selected-row)))
+ (start (point)))
+ (insert (org-kanban--format-card-line2 card col-width sel))
+ (put-text-property start (point) 'org-kanban-card card)
+ (put-text-property start (point) 'org-kanban-col col-idx)
+ (put-text-property start (point) 'org-kanban-row row))
+ (insert (make-string col-width ?\s)))
+ (when (< col-idx (1- (length columns)))
+ (insert " " separator " "))))
+ (insert "\n")
+
+ ;; Blank line between cards
+ (insert " ")
+ (dotimes (col-idx (length columns))
+ (insert (make-string col-width ?\s))
+ (when (< col-idx (1- (length columns)))
+ (insert " " separator " ")))
+ (insert "\n"))
+
+ (setq org-kanban--card-positions card-positions)
+
+ ;; Footer with keybinding help
+ (insert "\n")
+ (insert (propertize " hjkl/←↑↓→" 'face 'font-lock-keyword-face) " nav "
+ (propertize "</H" 'face 'font-lock-keyword-face) " state← "
+ (propertize ">/L" 'face 'font-lock-keyword-face) " state→ "
+ (propertize "RET" 'face 'font-lock-keyword-face) " goto "
+ (propertize "v/SPC" 'face 'font-lock-keyword-face) " preview "
+ (propertize "f" 'face 'font-lock-keyword-face) " filter "
+ (propertize "s" 'face 'font-lock-keyword-face) " sort "
+ (propertize "D" 'face 'font-lock-keyword-face) " done "
+ (propertize "g" 'face 'font-lock-keyword-face) " refresh "
+ (propertize "q" 'face 'font-lock-keyword-face) " quit")))
+
+;;; Selection and preview
+
+(defun org-kanban--update-preview (card)
+ "Update the preview window with CARD content, if visible."
+ (let ((preview-win (get-buffer-window "*org-kanban-preview*")))
+ (when preview-win
+ (let ((marker (plist-get card :marker)))
+ (when (and marker (marker-buffer marker))
+ (let ((content (with-current-buffer (marker-buffer marker)
+ (save-excursion
+ (goto-char marker)
+ (org-fold-show-entry)
+ (buffer-substring
+ (point)
+ (save-excursion (org-end-of-subtree t t) (point)))))))
+ (with-current-buffer (get-buffer-create "*org-kanban-preview*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert content)
+ (org-mode)
+ (goto-char (point-min))
+ (org-fold-show-all)
+ (org-cycle-hide-drawers 'all)
+ (read-only-mode 1)))))))))
+
+;;; Navigation
+
+(defun org-kanban--goto-card (col row)
+ "Select the card at COL and ROW.
+Re-renders the board to update the indicator, then moves point."
+ (when (gethash (cons col row) org-kanban--card-positions)
+ (setq org-kanban--selected-col col
+ org-kanban--selected-row row)
+ ;; Re-render to show the indicator (uses cached card data)
+ (org-kanban--render)
+ ;; Move point to the selected card
+ (goto-char (point-min))
+ (let ((found nil))
+ (while (and (not found) (not (eobp)))
+ (when (and (equal (get-text-property (point) 'org-kanban-col) col)
+ (equal (get-text-property (point) 'org-kanban-row) row))
+ (setq found t))
+ (unless found
+ (goto-char (next-single-property-change (point) 'org-kanban-card nil (point-max))))))
+ ;; Update selected card and preview
+ (let ((card (gethash (cons col row) org-kanban--card-positions)))
+ (when card
+ (setq org-kanban--selected-card card)
+ (org-kanban--update-preview card)))))
+
+(defun org-kanban-next-card ()
+ "Move to the next card (down or next column)."
+ (interactive)
+ (let ((col (get-text-property (point) 'org-kanban-col))
+ (row (get-text-property (point) 'org-kanban-row)))
+ (cond
+ ;; Try next row in same column
+ ((and col row (gethash (cons col (1+ row)) org-kanban--card-positions))
+ (org-kanban--goto-card col (1+ row)))
+ ;; Try first card in next column
+ ((and col (gethash (cons (1+ col) 0) org-kanban--card-positions))
+ (org-kanban--goto-card (1+ col) 0))
+ ;; Wrap to first card
+ ((gethash (cons 0 0) org-kanban--card-positions)
+ (org-kanban--goto-card 0 0))
+ ;; No card at point, find first card
+ (t (org-kanban--goto-card 0 0)))))
+
+(defun org-kanban-prev-card ()
+ "Move to the previous card (up or previous column)."
+ (interactive)
+ (let ((col (get-text-property (point) 'org-kanban-col))
+ (row (get-text-property (point) 'org-kanban-row)))
+ (cond
+ ;; Try previous row in same column
+ ((and col row (> row 0)
+ (gethash (cons col (1- row)) org-kanban--card-positions))
+ (org-kanban--goto-card col (1- row)))
+ ;; Try last card in previous column
+ ((and col (> col 0))
+ (let ((prev-col (1- col))
+ (r 0))
+ (while (gethash (cons prev-col (1+ r)) org-kanban--card-positions)
+ (cl-incf r))
+ (org-kanban--goto-card prev-col r)))
+ ;; No card at point, find first card
+ (t (org-kanban--goto-card 0 0)))))
+
+(defun org-kanban--col-count (col)
+ "Return the number of cards in column COL."
+ (let ((count 0))
+ (while (gethash (cons col count) org-kanban--card-positions)
+ (cl-incf count))
+ count))
+
+(defun org-kanban-next-column ()
+ "Move to the next column (right), keeping the same row or nearest card."
+ (interactive)
+ (let ((col (or org-kanban--selected-col 0))
+ (row (or org-kanban--selected-row 0))
+ (ncols (length (append org-kanban-columns
+ (when org-kanban--show-done org-kanban-done-columns)))))
+ (cl-loop for c from (1+ col) below ncols
+ for cnt = (org-kanban--col-count c)
+ when (> cnt 0)
+ do (org-kanban--goto-card c (min row (1- cnt)))
+ and return nil
+ finally
+ ;; Wrap around from the start
+ (cl-loop for c from 0 below col
+ for cnt = (org-kanban--col-count c)
+ when (> cnt 0)
+ do (org-kanban--goto-card c (min row (1- cnt)))
+ and return nil))))
+
+(defun org-kanban-prev-column ()
+ "Move to the previous column (left), keeping the same row or nearest card."
+ (interactive)
+ (let ((col (or org-kanban--selected-col 0))
+ (row (or org-kanban--selected-row 0))
+ (ncols (length (append org-kanban-columns
+ (when org-kanban--show-done org-kanban-done-columns)))))
+ (cl-loop for c downfrom (1- col) to 0
+ for cnt = (org-kanban--col-count c)
+ when (> cnt 0)
+ do (org-kanban--goto-card c (min row (1- cnt)))
+ and return nil
+ finally
+ ;; Wrap around from the end
+ (cl-loop for c downfrom (1- ncols) above col
+ for cnt = (org-kanban--col-count c)
+ when (> cnt 0)
+ do (org-kanban--goto-card c (min row (1- cnt)))
+ and return nil))))
+
+;;; Card operations
+
+(defun org-kanban--move-card (direction)
+ "Move the card at point in DIRECTION (:next or :prev) in the state order."
+ (let ((card (get-text-property (point) 'org-kanban-card)))
+ (when card
+ (let* ((current-state (plist-get card :state))
+ (marker (plist-get card :marker))
+ (heading (plist-get card :heading))
+ (idx (cl-position current-state org-kanban-state-order :test #'string=))
+ (new-idx (pcase direction
+ (:next (min (1- (length org-kanban-state-order)) (1+ idx)))
+ (:prev (max 0 (1- idx)))))
+ (new-state (nth new-idx org-kanban-state-order)))
+ (unless (string= current-state new-state)
+ ;; Change the state in the org file
+ (with-current-buffer (marker-buffer marker)
+ (save-excursion
+ (goto-char marker)
+ (org-todo new-state)))
+ (message "Moved \"%s\" → %s" heading new-state)
+ ;; Refresh board, try to stay near current position
+ (let ((col (get-text-property (point) 'org-kanban-col))
+ (row (get-text-property (point) 'org-kanban-row)))
+ (org-kanban-refresh)
+ ;; Try to navigate back to a reasonable position
+ (or (ignore-errors (org-kanban--goto-card col row) t)
+ (ignore-errors (org-kanban--goto-card col (max 0 (1- row))) t)
+ (org-kanban--goto-card 0 0))))))))
+
+(defun org-kanban-move-right ()
+ "Move the card at point to the next state."
+ (interactive)
+ (org-kanban--move-card :next))
+
+(defun org-kanban-move-left ()
+ "Move the card at point to the previous state."
+ (interactive)
+ (org-kanban--move-card :prev))
+
+(defun org-kanban-goto-heading ()
+ "Jump to the org heading for the card at point.
+Opens in a new tab if `org-kanban-open-in-tab' is non-nil."
+ (interactive)
+ (let ((card (get-text-property (point) 'org-kanban-card)))
+ (when card
+ (let ((marker (plist-get card :marker)))
+ (when (and marker (marker-buffer marker))
+ (if org-kanban-open-in-tab
+ (progn
+ (tab-bar-new-tab)
+ (switch-to-buffer (marker-buffer marker)))
+ (pop-to-buffer (marker-buffer marker)))
+ (goto-char marker)
+ (org-reveal)
+ (org-fold-show-entry))))))
+
+(defun org-kanban-preview ()
+ "Preview the card at point in a side window (toggle)."
+ (interactive)
+ (let ((win (get-buffer-window "*org-kanban-preview*")))
+ (if win
+ (quit-window nil win)
+ (let* ((card (get-text-property (point) 'org-kanban-card))
+ (marker (and card (plist-get card :marker))))
+ (when (and marker (marker-buffer marker))
+ (let ((content
+ (with-current-buffer (marker-buffer marker)
+ (save-excursion
+ (goto-char marker)
+ (org-fold-show-entry)
+ (buffer-substring
+ (point)
+ (save-excursion
+ (org-end-of-subtree t t)
+ (point)))))))
+ (with-current-buffer (get-buffer-create "*org-kanban-preview*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert content)
+ (org-mode)
+ (goto-char (point-min))
+ (org-fold-show-all)
+ (org-cycle-hide-drawers 'all)
+ (read-only-mode 1)))
+ (display-buffer "*org-kanban-preview*"
+ '((display-buffer-in-side-window)
+ (side . bottom)
+ (window-height . 0.35)))))))))
+
+;;; Filtering
+
+(defun org-kanban-filter-section ()
+ "Filter the board to show only items from a specific section."
+ (interactive)
+ (let* ((sections (org-ql-select org-kanban-file
+ '(level 1)
+ :action (lambda () (substring-no-properties (org-get-heading t t t t)))))
+ (choice (completing-read "Filter by section (empty to clear): "
+ sections nil nil)))
+ (setq org-kanban--section-filter (if (string-empty-p choice) nil choice))
+ (org-kanban-refresh)))
+
+(defun org-kanban-clear-filter ()
+ "Clear the section filter."
+ (interactive)
+ (setq org-kanban--section-filter nil)
+ (org-kanban-refresh))
+
+(defun org-kanban-cycle-sort ()
+ "Cycle through sort orders: priority → scheduled → deadline → alpha → none."
+ (interactive)
+ (let* ((current (or org-kanban--sort org-kanban-sort))
+ (order '(priority scheduled deadline alpha none))
+ (idx (cl-position current order))
+ (next (nth (mod (1+ (or idx 0)) (length order)) order)))
+ (setq org-kanban--sort next)
+ (setq org-kanban--cards (org-kanban--fetch-cards))
+ (setq org-kanban--selected-col nil
+ org-kanban--selected-row nil)
+ (org-kanban--render)
+ (goto-char (point-min))
+ (when (gethash (cons 0 0) org-kanban--card-positions)
+ (org-kanban--goto-card 0 0))
+ (message "Sort: %s" next)))
+
+(defun org-kanban-toggle-done ()
+ "Toggle visibility of DONE/CANX columns."
+ (interactive)
+ (setq org-kanban--show-done (not org-kanban--show-done))
+ (org-kanban-refresh))
+
+;;; Refresh
+
+(defun org-kanban-refresh ()
+ "Refresh the kanban board."
+ (interactive)
+ (setq org-kanban--cards (org-kanban--fetch-cards))
+ (setq org-kanban--selected-col nil
+ org-kanban--selected-row nil)
+ (org-kanban--render)
+ (goto-char (point-min))
+ ;; Navigate to first card
+ (when (gethash (cons 0 0) org-kanban--card-positions)
+ (org-kanban--goto-card 0 0)))
+
+;;; Major mode
+
+(defvar org-kanban-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; Navigation
+ (define-key map (kbd "j") #'org-kanban-next-card)
+ (define-key map (kbd "n") #'org-kanban-next-card)
+ (define-key map (kbd "<down>") #'org-kanban-next-card)
+ (define-key map (kbd "k") #'org-kanban-prev-card)
+ (define-key map (kbd "p") #'org-kanban-prev-card)
+ (define-key map (kbd "<up>") #'org-kanban-prev-card)
+ ;; Column navigation
+ (define-key map (kbd "l") #'org-kanban-next-column)
+ (define-key map (kbd "<right>") #'org-kanban-next-column)
+ (define-key map (kbd "h") #'org-kanban-prev-column)
+ (define-key map (kbd "<left>") #'org-kanban-prev-column)
+ ;; Move cards (change state)
+ (define-key map (kbd ">") #'org-kanban-move-right)
+ (define-key map (kbd "L") #'org-kanban-move-right)
+ (define-key map (kbd "<") #'org-kanban-move-left)
+ (define-key map (kbd "H") #'org-kanban-move-left)
+ ;; Actions
+ (define-key map (kbd "RET") #'org-kanban-goto-heading)
+ (define-key map (kbd "v") #'org-kanban-preview)
+ (define-key map (kbd "SPC") #'org-kanban-preview)
+ (define-key map (kbd "f") #'org-kanban-filter-section)
+ (define-key map (kbd "F") #'org-kanban-clear-filter)
+ (define-key map (kbd "s") #'org-kanban-cycle-sort)
+ (define-key map (kbd "D") #'org-kanban-toggle-done)
+ (define-key map (kbd "g") #'org-kanban-refresh)
+ (define-key map (kbd "q") #'quit-window)
+ map)
+ "Keymap for `org-kanban-mode'.")
+
+(define-derived-mode org-kanban-mode special-mode "OrgKanban"
+ "Major mode for the org-mode kanban board.
+\\{org-kanban-mode-map}"
+ (setq-local buffer-read-only t)
+ (setq-local truncate-lines t)
+ (setq-local cursor-type nil)
+ ;; Force monospace fixed-pitch font at uniform height to fix alignment
+ ;; with mixed-fonts themes (modus-themes-mixed-fonts, variable-pitch headings)
+ (face-remap-add-relative 'default :inherit 'fixed-pitch :height 1.0)
+)
+
+;;; Entry points
+
+;;;###autoload
+(defun org-kanban (&optional file)
+ "Open the kanban board for FILE (defaults to `org-kanban-file')."
+ (interactive)
+ (let ((buf (get-buffer-create "*org-kanban*")))
+ (with-current-buffer buf
+ (org-kanban-mode)
+ (when file
+ (setq-local org-kanban-file file))
+ (org-kanban-refresh))
+ (pop-to-buffer buf)))
+
+;;;###autoload
+(defun org-kanban-work ()
+ "Open the kanban board filtered to the Work section."
+ (interactive)
+ (let ((buf (get-buffer-create "*org-kanban*")))
+ (with-current-buffer buf
+ (org-kanban-mode)
+ (setq org-kanban--section-filter "Work")
+ (org-kanban-refresh))
+ (pop-to-buffer buf)))
+
+;;;###autoload
+(defun org-kanban-projects ()
+ "Open the kanban board filtered to the Projects section."
+ (interactive)
+ (let ((buf (get-buffer-create "*org-kanban*")))
+ (with-current-buffer buf
+ (org-kanban-mode)
+ (setq org-kanban--section-filter "Projects")
+ (org-kanban-refresh))
+ (pop-to-buffer buf)))
+
+;;;###autoload
+(defun org-kanban-systems ()
+ "Open the kanban board filtered to the Systems section."
+ (interactive)
+ (let ((buf (get-buffer-create "*org-kanban*")))
+ (with-current-buffer buf
+ (org-kanban-mode)
+ (setq org-kanban--section-filter "Systems")
+ (org-kanban-refresh))
+ (pop-to-buffer buf)))
+
+(provide 'org-kanban)
+;;; org-kanban.el ends here
dots/config/emacs/init.el
@@ -2281,6 +2281,10 @@ parameter), remove all other windows so the capture buffer fills the frame."
map)
"Keymap for daily-plan commands under C-c d."))
+(use-package org-kanban
+ :commands (org-kanban org-kanban-work org-kanban-projects org-kanban-systems)
+ :bind ("C-c K" . org-kanban))
+
(use-package org-habit
:after org
:custom