Download
(defvar todostack-version 1)
(require 'lisp-mnt nil t)
(defvar todostack-default-stack '()
"The default todostack.")
(defvar todostack-current-stack 'todostack-default-stack
"The stack to operate currently.")
(defgroup todostack nil
"Customization group for todostack."
:group 'applications
:prefix 'todostack)
(defcustom todostack-post-push-hook nil
"Hooks run after push of the stack.
Generally use `todostack-post-op-hook' instead."
:type 'hook :group 'todostack)
(defcustom todostack-post-pop-hook nil
"Hooks run after pop of the stack.
Generally use `todostack-post-op-hook' instead."
:type 'hook :group 'todostack)
(defcustom todostack-post-queue-hook nil
"Hooks run after a job is queued.
Generally use `todostack-post-op-hook' instead."
:type 'hook :group 'todostack)
(defcustom todostack-post-op-hook nil
"Hooks run after any stack-modifying function is run.
This is generally the only hook you should need."
:type 'hook
:options '(todostack-save)
:group 'todostack)
(defcustom todostack-post-list-buffer-hook nil
"Hooks run after the stack is listed in a buffer.
Turn on a mode, etc."
:type 'hook
:options '(org-mode)
:group 'todostack)
(defcustom todostack-before-save-hook '(todostack-backup)
"Hooks run before `todostack-save' does its work."
:type 'hook
:group 'todostack)
(defcustom todostack-list-function 'todostack-list-dwim
"Function to run when requesting a list of the current stack.
Should be a lambda or function of no arguments."
:type 'function :group 'todostack)
(defcustom todostack-list-line-prefix ""
"A string to append before each line in a a buffer listing of
the stack. Org-mode users might try \'* TODO \""
:type 'string :group 'todostack
:options '(todotack-list-line-prefix-org))
(defcustom todostack-save-file
(expand-file-name
"~/.emacs.d/todostacksave.el")
"The name of the file in which to save the todostack."
:type 'file :group 'todostack)
(defcustom todostack-backup-extension ".bak"
"File extension to tack on to `todostack-save-file' when making
automatic backups of the stack."
:type 'string :group 'todostack)
(defcustom todostack-list-buffer-name "*todostack*"
"Name to use for the `todostack-list' buffer.
This should apply if `todostack-list-function' points to a
function like `todostack-list-buffer'. Irrelevant if it points
to something that does not create a new buffer."
:type 'string :group 'todostack)
(defvar todostack-documentation
(if (and (fboundp 'lm-commentary)
(file-exists-p
(concat (file-name-sans-extension load-file-name)
".el")))
(substring
(replace-regexp-in-string
"^;; " ""
(lm-commentary
(concat
(file-name-sans-extension load-file-name) ".el")))
(length ";;; Commentary:\n"))
"Examine but do not modify the top of the stack.")
"Try to use the library headers as the doc string for function
`todostack'.")
(defun todostack-get-current-stack ()
"Return the current todo stack."
(eval todostack-current-stack))
(defun todostack-push (job)
"Add a to-do item to the top of the todo stack."
(interactive "MPush on to top of stack: ")
(set todostack-current-stack
(cons job (todostack-get-current-stack)))
(run-hooks 'todostack-post-push-hook)
(run-hooks 'todostack-post-op-hook)
(todostack))
(defun todostack-pop ()
"Remove the top-most entry from the todostack."
(interactive)
(let ((old (car (todostack-get-current-stack))))
(if (todostack-get-current-stack)
(progn
(set todostack-current-stack
(cdr (todostack-get-current-stack)))
(run-hooks 'todostack-post-pop-hook)
(run-hooks 'todostack-post-op-hook)
(message
(concat old " popped.\n"
(if (todostack-get-current-stack)
(concat "New top: "
(car (todostack-get-current-stack)))
"Todostack empty"))))
(message "Todostack empty"))))
(defun todostack ()
nil)
(fset 'todostack
`(lambda ()
,todostack-documentation
(interactive)
(if (todostack-get-current-stack)
(message (car (todostack-get-current-stack)))
(message "Todostack empty"))))
(defun todostack-list-buffer ()
"Create a buffer full of what you have to do."
(if (todostack-get-current-stack)
(progn
(switch-to-buffer
(get-buffer-create todostack-list-buffer-name))
(kill-region (point-min) (point-max))
(dolist (job (todostack-get-current-stack))
(insert (concat todostack-list-line-prefix job "\n")))
(message "Things to do")
(run-hooks 'todostack-post-list-buffer-hook))
(message "Todostack empty")))
(defun todostack-list-echo-area ()
"List what you have to do in the echo area.
If your todostack might be too large to fit in the echo area, a
better function to use might be `todostack-list-dwim'."
(if (todostack-get-current-stack)
(let* ((string "")
(string
(dolist (job (todostack-get-current-stack) string)
(setq string (concat string job "\n")))))
(message (substring string 0 (1- (length string)))))
(message "Todostack empty")))
(defun todostack-list-dwim ()
"List the todo stack in the echo area if it will fit.
Otherwise create a temporary buffer to list it."
(if (> (length (todostack-get-current-stack))
(if (integerp max-mini-window-height)
max-mini-window-height
(floor (* (frame-height) max-mini-window-height))))
(todostack-list-buffer)
(todostack-list-echo-area)))
(defun todostack-list ()
"List the contents of the todo stack.
Simply calls the function named by the variable
`todostack-list-function'."
(interactive)
(funcall todostack-list-function))
(defun todostack-procrastinate (n)
"Push the top item of the todostack N positions back.
Default is 1. If N is larger than the length of the todostack,
leave the top item at the back of the todostack.
Then show the new top item in the echo area."
(interactive "p")
(if (> n (1- (length (todostack-get-current-stack))))
(todostack-rotate 1)
(let* ((n (1+ n))
(old (todostack-get-current-stack))
(procrastinand (car old))
(new-tail (cons procrastinand (nthcdr n old)))
(new-head (cdr (butlast old (- (length old) n)))))
(set todostack-current-stack (append new-head new-tail))))
(run-hooks 'todostack-post-op-hook)
(todostack))
(defun todostack-rotate (n)
"Push the first item in the todo stack back to the last position.
With prefix arg, do this N consecutive times. Then show the new
top item in the echo area."
(interactive "p")
(dotimes (foo n (todostack-get-current-stack))
(set todostack-current-stack
(append (cdr (todostack-get-current-stack))
(list (car (todostack-get-current-stack))))))
(run-hooks 'todostack-post-op-hook)
(todostack))
(defun todostack-queue (job)
"Add a new item directly to the bottom of the stack.
This is a way to use the stack more like a queue."
(interactive "MAdd to bottom of stack: ")
(let ((todostack-post-push-hook nil)
(todostack-post-op-hook nil))
(todostack-push job))
(todostack-rotate 1)
(run-hooks 'todostack-post-queue-hook)
(run-hooks 'todostack-post-op-hook))
(defun todostack-org-snarf (&optional p)
"Add TODO items in an org-mode style list to the todo stack.
With prefix argument replace the current todo stack with the
contents of the buffer.
Items are pushed to the top of the stack from the bottom-most
TODO item in the buffer to the top-most, leaving the todo stack
looking like the buffer, thus:
** TODO A
*** TODO B
* TODO C
Will end up creating a stack with \"A\" at the top and \"C\" at
the bottom. If this is not good, one possibility is to snarf
your TODO list, then use `todostack-list-buffer' to create a new
list, re-organize it and then re-snarf that with the prefix arg.
Items added will be anything on a line consisting of any number
of asterisk characters followed by the string TODO and a space.
Lines that do not match are ignored."
(interactive "P")
(let ((temp '()))
(save-excursion
(goto-char (point-max))
(while
(re-search-backward "^\** TODO " nil t)
(let ((beginning (search-forward "TODO ")))
(end-of-line)
(setq temp
(cons (buffer-substring-no-properties beginning (point))
temp)))
(beginning-of-line)))
(if p (set todostack-current-stack temp)
(set todostack-current-stack
(append temp (todostack-get-current-stack)))))
(run-hooks 'todostack-post-op-hook)
(todostack))
(defun todostack-help ()
"Display some help for todostack."
(interactive)
(describe-function 'todostack))
(defun todostack-save ()
"Save the todostack to a file named by `todostack-save-file'."
(interactive)
(run-hooks 'todostack-before-save-hook)
(with-temp-buffer
(insert
(concat
";; This file was created programatically by todostack.el."
"\n;; Edit by hand at your own risk.\n"
"\n\(setq "
(prin1-to-string todostack-current-stack)
" '"
(prin1-to-string (todostack-get-current-stack)) "\)"))
(write-file (expand-file-name todostack-save-file))))
(defun todostack-load ()
"Load the todostack from the file named by
`todostack-save-file'."
(interactive)
(load-file (expand-file-name todostack-save-file)))
(defun todostack-backup (&optional tofile)
"Make a backup copy of the current todostack."
(unless (file-exists-p todostack-save-file)
(with-temp-buffer (write-file todostack-save-file)))
(let ((file (if tofile tofile todostack-save-file)))
(copy-file todostack-save-file
(concat (expand-file-name file)
todostack-backup-extension) t)))
(defun todostack-rescue (&optional file)
"Load the todostack backup file but do not save it."
(interactive)
(let ((file (if file file
(concat (expand-file-name todostack-save-file)
todostack-backup-extension))))
(if (file-exists-p file)
(progn (load-file file)
(message "Backup loaded. You must save it manually\
with todostack-save."))
(error "Backup file by that name does not exist"))))
(defun todostack-test ()
"Quick and dirty check to make sure basic things are working.
Note that this will produce a save file for the test."
(let* ((stack '())
(todostack-default-stack stack)
(todostack-save-file "~/.emacs.d/todostacktest.el")
(todostack-list-function 'todostack-list-buffer)
(todostack-list-line-prefix ""))
(todostack-push "A")
(todostack-push "B")
(todostack-push "C")
(todostack-queue "D")
(todostack-rotate 1)
(todostack-rotate 2)
(todostack-pop)
(todostack-procrastinate 1)
(todostack-push "D")
(todostack-procrastinate 200)
(todostack-procrastinate 2)
(todostack-procrastinate 2)
(todostack-list)
(message "Should say: A B C D.")))
(provide 'todostack)