Skip to content

Commit

Permalink
Important improvements.
Browse files Browse the repository at this point in the history 
- Try to guess before ask to user based on priority, deadline and scheduled time.
- C-g build a partial list instead abort everything.
- Warn user if it will take more than 20 steps.
- User can now set a tolerance to decrease the necessary steps.
  • Loading branch information
@felipelalli
felipelalli committed May 11, 2019
1 parent 4953a8c commit 51fa512
Showing 1 changed file with 147 additions and 72 deletions.
219 changes: 147 additions & 72 deletions org-sort-tasks.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -74,68 +74,151 @@ See also: `-flatten-n'"

;; Code:

(defun sort-tasks/sort-list (task-list)
"This fn receives a list of tasks. Each task is a vector composed by the title of task and its raw content. It uses the merge sort technique to sort the list asking to the user which task should be done before another task.
(defun sort-tasks/timestamp-obj=? (ts1 ts2)
"Compare two timestamp object and returns true if they are equal until day level."
(and (= (org-element-property :year-start ts1)
(org-element-property :year-start ts2))
(= (org-element-property :month-start ts1)
(org-element-property :month-start ts2))
(= (org-element-property :day-start ts1)
(org-element-property :day-start ts2))))

(defun sort-tasks/timestamp-obj<? (ts1 ts2)
"Compare two timestamp object and returns true if ts1 is early than ts2 until day level."
(or (< (org-element-property :year-start ts1)
(org-element-property :year-start ts2))
(and (= (org-element-property :year-start ts1)
(org-element-property :year-start ts2))
(< (org-element-property :month-start ts1)
(org-element-property :month-start ts2)))
(and (= (org-element-property :year-start ts1)
(org-element-property :year-start ts2))
(= (org-element-property :month-start ts1)
(org-element-property :month-start ts2))
(< (org-element-property :day-start ts1)
(org-element-property :day-start ts2)))))

(defun sort-tasks/sort (task1 task2 do-not-ask-to-user)
"Decides if task1 should be done before task2 or not. First, look to deadline, scheduled, priority and then ask to the user."
(let ((t1 (or (org-element-property :deadline task1) (org-element-property :scheduled task1)))
(t2 (or (org-element-property :deadline task2) (org-element-property :scheduled task2)))
(p1 (or (org-element-property :priority task1) org-default-priority))
(p2 (or (org-element-property :priority task2) org-default-priority)))
(cond ((eq (org-element-property :todo-type task1) 'done) nil)
((eq (org-element-property :todo-type task2) 'done) t)
((and t1 (not t2)) t)
((and t2 (not t1)) nil)
((and t1 t2
(not (sort-tasks/timestamp-obj=? t1 t2)))
(if (sort-tasks/timestamp-obj<? t1 t2) t nil))
((< p1 p2) t)
((> p1 p2) nil)
(do-not-ask-to-user t)
(t (not (with-local-quit
(y-or-n-p (format "Should:\n...'%s'\nbe done *BEFORE*\n...'%s'?"
(car (org-element-property :title task2))
(car (org-element-property :title task1))))))))))

(defun sort-tasks/sort-list (task-list tolerance)
"This fn receives a list of tasks. Each task is a vector composed by the task element itself and its raw content. It uses the merge sort technique to sort the list asking to the user which task should be done before another task.
Note: sort-tasks/sort-list is private and is used by sort-tasks/sort-children"
(let ((sorted-list
(cond ((<= (length task-list) 1) task-list)
((= (length task-list) 2)
(if (y-or-n-p (format "'%s' *SHOULD BE DONE BEFORE* '%s'?"
(aref (nth 0 task-list) 0)
(aref (nth 1 task-list) 0)))
task-list
(reverse task-list)))
(t (let ((pivot (/ (length task-list) 2))
(left-list '())
(right-list '()))
(cl-labels ((go-next (c)
(cond ((= c pivot)
(go-next (+ c 1)))
((>= c (length task-list))
(list (sort-tasks/sort-list left-list)
(nth pivot task-list)
(sort-tasks/sort-list right-list)))
(t (progn
(if (y-or-n-p (format "'%s' *SHOULD BE DONE BEFORE* '%s'?"
(aref (nth c task-list) 0)
(aref (nth pivot task-list) 0)))
(setq left-list (cons (nth c task-list) left-list))
(setq right-list (cons (nth c task-list) right-list)))
(go-next (+ c 1)))))))
(go-next 0)))))))
(cond ((<= (length task-list) 1) task-list)
((= (length task-list) 2)
(if (sort-tasks/sort
(aref (nth 0 task-list) 0)
(aref (nth 1 task-list) 0)
(<= (length task-list) tolerance))
task-list
(reverse task-list)))
(t (let ((pivot (/ (length task-list) 2))
(left-list '())
(right-list '()))
(cl-labels ((go-next (c)
(cond ((= c pivot)
(go-next (+ c 1)))
((>= c (length task-list))
(list (sort-tasks/sort-list left-list tolerance)
(nth pivot task-list)
(sort-tasks/sort-list right-list tolerance)))
(t (progn
(if (sort-tasks/sort
(aref (nth c task-list) 0)
(aref (nth pivot task-list) 0)
(<= (length task-list) tolerance))
(setq left-list (cons (nth c task-list) left-list))
(setq right-list (cons (nth c task-list) right-list)))
(go-next (+ c 1)))))))
(go-next 0)))))))
(sort-tasks/flatten sorted-list)))

(defun sort-tasks/sort-children (final-buffer element)
(defun sort-tasks/sort-children (final-buffer element tolerance)
"This fn receives a root element and sort all its children.
Note: sort-tasks/sort-children is private and it is used by the main org-sort-tasks fn."
(let* ((list-of-tasks
(org-element-map element 'headline
(lambda (task)
(if (and (= (+ (org-element-property :level element) 1)
(org-element-property :level task))
(eq (org-element-property :todo-type task)
'todo))
(vector (car (org-element-property :title task))
(buffer-substring (org-element-property :begin task)
(org-element-property :end task)))
nil))))
(sorted-list (sort-tasks/sort-list list-of-tasks)))
(with-current-buffer final-buffer
(insert (format "* %s\n" (car (org-element-property :title element))))
(mapcar (lambda (c)
(insert (format "%s" (aref c 1))))
sorted-list)
(org-element-map element 'headline
(lambda (task)
(if (and (= (+ (org-element-property :level element) 1)
(org-element-property :level task)))
(vector task
(buffer-substring (org-element-property :begin task)
(org-element-property :end task)))
nil))))
(aprox-steps (ceiling (* (length list-of-tasks) (log (max 1 (length list-of-tasks)) 5)))))
(and (or (<= aprox-steps 20)
(y-or-n-p (format "It will take aprox. %s steps to sort this list. Are you READY?" aprox-steps)))
(let ((sorted-list (sort-tasks/sort-list list-of-tasks tolerance)))
(with-current-buffer final-buffer
(insert (format "* %s\n" (car (org-element-property :title element))))
(mapcar (lambda (c)
(insert (format "%s" (aref c 1))))
sorted-list)
t)))))

(defun org-sort-tasks/main (tolerance)
(cl-assert (>= tolerance 1) t "tolerance should be >= 1: %d")
(let ((final-buffer (generate-new-buffer "*sorted-tasks*"))
(no-selection (not (use-region-p)))
(inhibit-quit t)) ; If C-g is pressed then try to build a partial sorted list.
(with-current-buffer final-buffer (erase-buffer))
(when no-selection
(beginning-of-line)
(org-mark-subtree))
(deactivate-mark)
(save-restriction
(narrow-to-region (region-beginning) (region-end))
(beginning-of-buffer)
(org-mode)
(org-cycle)
(message "Done! A sorted list was built and opened in a new disposable buffer.")
)))
(let ((first-element (org-element-at-point)))
(if (not (eq (org-element-type first-element) 'headline))
(error "The first element must be a headline.")
(let ((result-list
(org-element-map (org-element-parse-buffer) 'headline
(lambda (task)
(when (= (org-element-property :level first-element)
(org-element-property :level task))
(sort-tasks/sort-children final-buffer task tolerance))))))
(if (= (length result-list) 0)
(message "Aborted.")
(progn
(switch-to-buffer final-buffer)
(beginning-of-buffer)
(org-mode)
(org-cycle)
(message "Done! A sorted list was built and opened in a new disposable buffer.")))))))))

(defun org-sort-tasks-with-tolerance (tolerance)
"Same as 'org-sort-tasks' but you can pass a tolerance as parameter. 1 mean no tolerance and as you increase the value, more tolerance."
(interactive "nTolerance (1 to n):")
(org-sort-tasks/main tolerance))

(defun org-sort-tasks-with-some-tolerance ()
"An interactive fn that sorts a list of tasks in the selected region or under the headline on cursor with some tolerance (= 2).
See the long description in fn 'org-sort-tasks'."
(interactive)
(org-sort-tasks/main 2))

;;
;; MAIN INTERACTIVE FUNCTION "org-sort-tasks".
;;
(defun org-sort-tasks ()
"An interactive fn that sorts a list of tasks in the selected region or under the headline on cursor.
Expand All @@ -144,27 +227,19 @@ There are two main ways of use:
1) You can let the cursor above any position of a headline and press M-x org-sort-tasks.
2) You can select a region and use M-x org-sort-tasks.
The user will be prompted to reply a simple question like \"Is 'xxx task' SHOULD BE DONE BEFORE 'yyy task'?\". After reply some questions, the fn will open a new buffer and build a sorted list of tasks. It is very useful for who uses GTD method and work with huge unsorted lists of tasks."
The user will be prompted to reply a simple question like \"Is 'xxx task' SHOULD BE DONE BEFORE 'yyy task'?\". After reply some questions, the fn will open a new buffer and build a sorted list of tasks. It is very useful for who uses GTD method and work with huge unsorted lists of tasks.
See also:
- org-sort-tasks-with-tolerance
- org-sort-tasks-with-some-tolerance
"
(interactive)
(let ((final-buffer (generate-new-buffer "*sorted-tasks*"))
(no-selection (not (use-region-p))))
(with-current-buffer final-buffer (erase-buffer))
(when no-selection
(beginning-of-line)
(org-mark-subtree))
(deactivate-mark)
(save-restriction
(narrow-to-region (region-beginning) (region-end))
(beginning-of-buffer)
(let ((first-element (org-element-at-point)))
(if (not (eq (org-element-type first-element) 'headline))
(error "The first element must be a headline.")
(progn
(org-element-map (org-element-parse-buffer) 'headline
(lambda (task)
(when (= (org-element-property :level first-element)
(org-element-property :level task))
(sort-tasks/sort-children final-buffer task))))
(switch-to-buffer final-buffer)))))))
(org-sort-tasks/main 1))

;; Export

(provide 'org-sort-tasks)
(provide 'org-sort-tasks-with-tolerance)
(provide 'org-sort-tasks-with-some-tolerance)
; org-fix-task-position

0 comments on commit 51fa512

Please sign in to comment.