(Arne Babenhauserheide)
2017-01-17: finally merge kanban-fill by stackeffect finally merge kanban-fill by stackeffect
diff --git a/kanban.el b/kanban.el
--- a/kanban.el
+++ b/kanban.el
@@ -48,7 +48,7 @@
;; |---+---+---|
;; | | | |
;; | | | |
-;; #+TBLFM: @1='(kanban-headers $#)::@2$1..@>$>='(kanban-zero @# $# "TAG" '(list-of-files))
+;; #+TBLFM: @1$1='(kanban-headers)::@2$1..@>$>='(kanban-zero @# $# "TAG" '(list-of-files))
;; "TAG" and the list of files are optional
;;
;; * Stateful Kanban: Use org-mode to retrieve tasks, but track their state in the Kanban board
@@ -57,7 +57,7 @@
;; |---+---+---|
;; | | | |
;; | | | |
-;; #+TBLFM: @1='(kanban-headers $#)::@2$1..@>$1='(kanban-todo @# @2$2..@>$> "TAG" '(list-of-files))
+;; #+TBLFM: @1$1='(kanban-headers)::@2$1..@>$1='(kanban-todo @# @2$2..@>$> "TAG" '(list-of-files))
;; "TAG" and the list of files are optional
;;
;; TODO: The links don’t yet work for tagged entries. Fix that. There
@@ -78,86 +78,161 @@
;;
;;; Code:
-;; Get the defined todo-states from the current org-mode document.
-;;;###autoload
-(defun kanban-headers (column)
- "Fill the headers of your table with your org-mode TODO
-states. If the table is too narrow, the only the first n TODO
-states will be shown, with n as the number of columns in your
-table."
- (let ((words org-todo-keywords-1))
- (nth (- column 1) words)))
-
(defcustom kanban-max-column-width 30
"The maximum width of the columns in the KANBAN table.")
-(defun kanban--todo-links-function ()
+;; Get the defined todo-states from the current org-mode document.
+;;;###autoload
+(defun kanban-headers (&optional startcolumn)
+ "Fill the headers of your table with your org-mode TODO
+states. If the table is too narrow, the only the first n TODO
+states will be shown, with n as the number of columns in your
+table.
+
+Only not already present TODO states will be filled into empty
+fields starting from the current column. All columns left of
+the current one are left untouched.
+
+Optionally ignore fields in columns left of STARTCOLUMN"
+ (let* ((ofc (org-table-get nil nil)) ; remember old field content
+ (col (org-table-current-column)) ; and current column
+ (startcolumn (or startcolumn col))
+ (kwl org-todo-keywords-1)
+ kw)
+ (while (setq kw (pop kwl)) ; iterate over all TODO states
+ (let ((matchcol 0) ; insert kw in this empty column
+ (n startcolumn)
+ field)
+ (while (and matchcol (<= n org-table-current-ncol))
+ (if (equal kw (setq field (org-table-get nil n)))
+ (setq matchcol nil) ; kw already in column n
+ (if (and (= 0 matchcol) (equal "" field))
+ (setq matchcol n))) ; remember first empty column
+ (setq n (+ 1 n)))
+ (when (and matchcol (> matchcol 0))
+ (if (= matchcol col) (setq ofc kw))
+ (save-excursion
+ (org-table-get-field matchcol kw)))))
+ ofc))
+
+(defun kanban--todo-links-function (srcfile)
"Retrieve the current header as org-mode link."
- (let ((file (buffer-file-name))
- (line (filter-buffer-substring
- (point) (line-end-position)))
+ (let* ((file (buffer-file-name))
+ (oe (org-element-at-point))
+ (title (org-element-property :title oe))
+ (link (org-element-property :CUSTOM_ID oe)))
+; (if (equal file srcfile) (setq file nil))
; yes, I can use the row variable. It bleeds over from the
; calling function.
- (keyword (nth (- row 1) org-todo-keywords-1)))
(if file
(setq file (concat file "::")))
- ; clean up the string
- (let* (; first remove the initial headline marker FIXME: currently gets later "* ", too
- (cleanline (substring
- (string-join (cdr (split-string line "* ")) "* ")
- (if (version<= (org-version) "9")
- 0 ; old org-mode matches with TODO keyword
- (+ (length keyword) 1))))
- ; and kill off links in the link part
- (link (replace-regexp-in-string "\\[" "%5B"
- (replace-regexp-in-string "\\]" "%5D" cleanline)))
- ; then kill off trailing space and tags in the name part
- (notrailing (replace-regexp-in-string "\\( +$\\| +:\\w.*: *$\\)" "" cleanline))
- ; and links
- (nolinks (replace-regexp-in-string
- "\\[" "{" (replace-regexp-in-string
- "\\]" "}" (replace-regexp-in-string
- "\\[\\[\\(.*\\)\\]\\[\\(.*\\)\\]\\]" "{\\2}" notrailing))))
+ ; find best target
+ (cond
+ (link
+ (setq link (concat "#" link)))
+ ((string-match org-target-regexp title)
+ (setq link (match-string 1 title))
+ (setq title nil))
+ (file
+ (setq link title)))
+ ; clean up the title
+ (when title
+ ; first substitute links with their title
+ (setq title (replace-regexp-in-string "\\[\\(\\[[^]]+\\]\\)?\\[\\([^]]+\\)\\]\\]" "\\2" title))
+ ; then kill off special link relevant characters
+ (setq title (replace-regexp-in-string "\\[" "{"
+ (replace-regexp-in-string "\\]" "}" title)))
; finally shorten the string to a maximum length of kanban-max-column-width chars
- (clean (substring nolinks
- 0
- (min kanban-max-column-width (length nolinks)))))
- (concat "[[" file link "][" clean "]]" ))))
+ (setq title (substring title 0 (min kanban-max-column-width (length title)))))
+ ; clean up the link
+ (when (string-match "[\][]" link)
+ (setq link (substring link 1))
+ (setq link (regexp-quote link))
+ (setq link (replace-regexp-in-string "\\(\\\\\\[\\|]\\|/\\)" "." link))
+ (setq link (concat "/\\*.*" link "/"))
+ (if (not file) (setq file "file:::")))
+ (concat "[[" file link (if title (concat "][" title)) "]]" )))
+
+;; Get TODO of current column from field in row 1
+(defun kanban--get-todo-of-current-col ()
+ "Get TODO of current column from field in row 1 or nil if
+row 1 does not contain a valid TODO"
+ (let ((todo (org-table-get 1 nil)))
+ (if (member todo org-todo-keywords-1) todo)))
;; Fill the kanban table with tasks with corresponding TODO states from org files
;;;###autoload
-(defun kanban-zero (column row &optional match scope)
+(defun kanban-zero (row column &optional match scope)
"Zero-state Kanban board: This Kanban board just displays all
org-mode headers which have a TODO state in their respective TODO
state. Useful for getting a simple overview of your tasks.
-Gets the COLUMN and ROW via TBLFM ($# and @#) and can get a string as MATCH to select only entries with a matching tag, as well as a list of org-mode files as the SCOPE to search for tasks."
- (let
- ((elem (nth (- column 2)
- (delete nil (org-map-entries
- 'kanban--todo-links-function
+Gets the ROW and COLUMN via TBLFM ($# and @#) and can get a string as MATCH to select only entries with a matching tag, as well as a list of org-mode files as the SCOPE to search for tasks."
+ (let*
+ ((todo (kanban--get-todo-of-current-col))
+ (srcfile (buffer-file-name))
+ (elem (and todo (nth (- row 2)
+ (delete nil (org-map-entries
+ '(kanban--todo-links-function srcfile)
; select the TODO state via the matcher: just match the TODO.
(if match
- (concat match "+TODO=\"" (nth (- row 1) org-todo-keywords-1) "\"")
- (concat "+TODO=\"" (nth (- row 1) org-todo-keywords-1) "\""))
+ (concat match "+TODO=\"" todo "\"")
+ (concat "+TODO=\"" todo "\""))
; read all agenda files
(if scope
scope
- 'agenda))))))
+ 'agenda)))))))
(if (equal elem nil)
""
elem)))
-; Fill the first row with TODO items, except if they exist in other cels
+(defun kanban--normalize-whitespace (elem)
+"Return ELEM with sequences of spaces reduced to 1 space"
+(replace-regexp-in-string "\\W\\W+" " " elem))
+
+(defun kanban--member-of-table (elem &optional skipcol)
+"Check if ELEM is in some table field
+ignoring all elements of column SKIPCOL.
+
+If SKIPCOL is not set column 1 will be ignored."
+(if (org-at-table-p)
+ (let ((row 2)
+ (skipcol (or skipcol 1))
+ col result field)
+ (while (and (not result) (<= row (length org-table-dlines)))
+ (setq col (if (= 1 skipcol) 2 1))
+ (while (and (not result) (<= col org-table-current-ncol))
+ (setq field (org-table-get row col))
+ (if (and field elem)
+ (setq result (or result (equal (kanban--normalize-whitespace elem) (kanban--normalize-whitespace field)))))
+ (setq col (1+ col))
+ (if (= col skipcol) (setq col (1+ col))))
+ (setq row (1+ row)))
+ result)))
+
+(defun kanban--max-row-or-hline ()
+ "Determine data row just above next hline or last row of current table"
+ (if (org-at-table-p)
+ (let ((row (org-table-current-dline)))
+ (while (and
+ (< row (1- (length org-table-dlines)))
+ (aref org-table-dlines row)
+ (aref org-table-dlines (1+ row))
+ (= (1+ (aref org-table-dlines row)) (aref org-table-dlines (1+ row))))
+ (setq row (1+ row)))
+ row)))
+
+; Fill the first column with TODO items, except if they exist in other cels
;;;###autoload
-(defun kanban-todo (column cels &optional match scope)
- "Kanban TODO item grabber. Fills the first row of the kanban
+(defun kanban-todo (row cels &optional match scope)
+ "Kanban TODO item grabber. Fills the first column of the kanban
table with org-mode TODO entries, if they are not in another cell
of the table. This allows you to set the state manually and just
use org-mode to supply new TODO entries.
-Gets the COLUMN and all other CELS via TBLFM ($# and @2$2..@>$>) and can get a string as MATCH to select only entries with a matching tag, as well as a list of org-mode files as the SCOPE to search for tasks."
- (let ((elem (nth (- column 2) (delete nil
+Gets the ROW and all other CELS via TBLFM ($# and @2$2..@>$>) and can get a string as MATCH to select only entries with a matching tag, as well as a list of org-mode files as the SCOPE to search for tasks."
+ (let* ((srcfile (buffer-file-name))
+ (elem (nth (- row 2) (delete nil
(org-map-entries
(lambda
()
@@ -165,6 +240,7 @@ Gets the COLUMN and all other CELS via T
((file (buffer-file-name))
(line (filter-buffer-substring (point) (line-end-position)))
(keyword (nth 0 org-todo-keywords-1)))
+ (if (equal file srcfile) (setq file nil))
(if file
(setq file (concat file "::")))
(let* ((cleanline (nth 1 (split-string line "* ")))
@@ -192,6 +268,51 @@ Gets the COLUMN and all other CELS via T
elem))) ; otherwise use the element.
+(defun kanban-fill (&optional match scope)
+ "Kanban TODO item grabber. Fills the current row of the kanban
+table with org-mode TODO entries, if they are not in another cell
+of the table. This allows you to set the state manually and just
+use org-mode to supply new TODO entries.
+
+Can get a string as MATCH to select only entries with a matching tag, as well as a list of org-mode files as the SCOPE to search for tasks.
+
+Only not already present TODO states will be filled into empty
+fields starting from the current field. All fields above the current
+one are left untouched."
+ (let* ((ofc (org-table-get nil nil)) ; remember old field content
+ (row (org-table-current-dline))
+ (startrow row)
+ (col (org-table-current-column)) ; and current column
+ (srcfile (buffer-file-name))
+ (todo (kanban--get-todo-of-current-col))
+ (maxrow (kanban--max-row-or-hline))
+ (elems (delete nil (org-map-entries
+ '(kanban--todo-links-function srcfile)
+ ; select the TODO state via the matcher: just match the TODO.
+ (if match
+ (concat match "+TODO=\"" todo "\"")
+ (concat "+TODO=\"" todo "\""))
+ ; read all agenda files
+ (if scope
+ scope
+ 'agenda))))
+ (elem t))
+ (save-excursion
+ (while (and elem (<= row maxrow))
+ (setq elem (pop elems))
+ (while (and elem (kanban--member-of-table elem 0))
+ (setq elem (pop elems)))
+ (while (and elem (<= row maxrow) (not (equal "" (org-table-get row col))))
+ (if (= row maxrow)
+ (setq elem nil) ; stop search
+ (setq row (1+ row)))) ; skip non empty rows
+ (when (and elem (equal "" (org-table-get row col)))
+ (if (= row startrow) (setq ofc elem))
+ (save-excursion
+ (if (org-table-goto-line row)
+ (org-table-get-field col elem))))))
+ (org-table-goto-column col)
+ ofc))
;; An example for auto-updating kanban tables from duply.han
;; I use the double-dash to mark this as "private" function
diff --git a/sample.org b/sample.org
--- a/sample.org
+++ b/sample.org
@@ -5,17 +5,73 @@ Example Kanban File
#+FILETAGS: board
#+CATEGORY: board
#+STARTUP: nofold
-* Zero state Kanban: == * Attention * ==
-| TODO | NEXT | DONE | WAITING | HOLD | MAYBE |
-|------+----------------------+------+---------+------+-------|
-| | | | | | |
-| | | | | | |
-| | | | | | |
-| | | | | | |
-| | | | | | |
-| | | | | | |
-| | | | | | |
-| | | | | | |
-| | | | | | |
-| | | | | | |
-#+TBLFM: @2$1..@>$>='(kanban-zero @# $# "+prj-HOLD" '(org-agenda-files))::@1='(kanban-headers $#)
+#+TODO: TODO NEXT DOING WAITING | DONE HOLD
+
+* Zero state Kanban: kanban-zero: == * Attention * ==
+| TODO | NEXT | DONE | WAITING | HOLD | MAYBE |
+|------+------+------+---------+------+-------|
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+#+TBLFM: @2$1..@>$>='(kanban-zero @# $# "+prj-HOLD" '("sample.org"))::@1='(kanban-headers $#)
+
+* Zero state Kanban: kanban-fill: == * Attention * ==
+| | | | | WAITING | |
+|---+---+---+---+---------+---|
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+#+TBLFM: @2='(kanban-fill "+prj-HOLD" '("sample.org"))::@1$1='(kanban-headers $#)
+
+* Todo state Kanban: == * Attention * ==
+| | | | | WAITING | |
+|---+---+---+---+---------+---|
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+| | | | | | |
+#+TBLFM: @2$1='(kanban-fill "+prj-HOLD" '("sample.org"))::@1$1='(kanban-headers $#)
+
+* item 1 :prj:
+ This item is totally ignored because not having any active state.
+* TODO item 2 :prj:
+ Only TODO items are relevant for todo state kanban.
+* NEXT item 3 :prj:
+* DOING item 4 :prj:
+* WAITING item 5 :prj:
+* DONE item 6 :prj:
+* HOLD item 7 :prj:
+ This item is ignored because of state "HOLD".
+* TODO item 8 :prj:
+ Only TODO items are relevant for todo state kanban.
+* TODO <<item 9>> :prj:
+ Link destination formatted as dedicated target.
+* NEXT item 10 :prj:
+ :PROPERTIES:
+ :CUSTOM_ID: i_am_item_10
+ :END:
+ Using CUSTOM_ID is the most safe method to set a link destination.
+* DOING item 11 :prj:
+* TODO item 12 :prj:
+* TODO item 13
+ Ignored because of missing tag prj.
+* DOING item 14 :prj:
+* NEXT item 15 :prj: