dot-emacs/config/init-org.el

(use-package org
  :mode ("\\.org\\'" . org-mode)
  :bind
  (:prefix-map qrthi/org-prefix
	       :prefix "C-c o"
	       ("a" . org-agenda)
	       ("c" . org-capture)
	       ("l" . org-store-link)
	       ("t d" . org-clock-display)
	       ("t g" . org-clock-goto)
	       ("t l" . org-clock-in-last)
	       ("t o" . org-clock-out)
	       ("t r" . org-clock-report)
	       ("t s" . org-clock-cancel)
	       ("t i" . org-clock-in)
	       )
  (:map org-mode-map
	("M-h" . backward-kill-word)
	("C-c >" . org-demote-subtree)
	("C-c <" . org-promote-subtree)
	("C-c o m f" . org-metaright)
	("C-c o m b" . org-metaleft)
	("C-c o m n" . org-metadown)
	("C-c o m p" . org-metaup)
	)
  :custom
  (org-agenda-files `(,org-directory))
  ;; (org-agenda-sticky nil)
  (org-agenda-restore-windows-after-quit t)
  (org-cycle-level-faces nil)
  (org-clocktable-defaults
   '(:maxlevel 5 :scope subtree :block untilnow :wstart 1 :mstart 1 :indent t
	       ))
  (org-directory (expand-file-name "org" qrthi/directory-documents))
  (org-todo-keywords
   '((sequence "TODO(t)" "IN-PROGRESS(i)" "WAITING(w)" "DONE(d)")
     ;; (sequence "TODO" "IN-PROGRESS" "|" "WAITING" "DONE")
     ))
  (org-todo-keyword-faces
   '(("TODO" . org-warning)
     ("WAITING" . org-agenda-dimmed-todo-face)))
  (org-src-window-setup 'current-window)
  (org-babel-load-languages
   '((emacs-lisp . t)
     (scheme . t)
     (ledger . t)
     (scheme . t)
     (python . t)
     (awk . t)))
  (org-clock-into-drawer "CLOCKING")
  (org-clock-persist t)
  :init
  (defun qrthi/org-fast-todo-selection (&optional current-state)
    "Fast TODO keyword selection with single keys.
Returns the new TODO keyword, or nil if no state change should occur.
When CURRENT-STATE is given and selection letters are not unique globally,
prefer a state in the current sequence over on in another sequence."
    (let* ((fulltable org-todo-key-alist)
	   (head (org-get-todo-sequence-head current-state))
	   (done-keywords org-done-keywords) ;; needed for the faces.
	   (maxlen (apply 'max (mapcar
				(lambda (x)
				  (if (stringp (car x)) (string-width (car x)) 0))
				fulltable)))
	   (expert (equal org-use-fast-todo-selection 'expert))
	   (prompt "")
	   (fwidth (+ maxlen 3 1 3))
	   (ncol (/ (- (window-width) 4) fwidth))
	   tg cnt e c tbl subtable
	   groups ingroup in-current-sequence)
      (save-excursion
	(save-window-excursion
	  (if expert
	      (set-buffer (get-buffer-create " *Org todo*"))
	    ;; (delete-other-windows)
	    (set-window-buffer (split-window-vertically) (get-buffer-create " *Org todo*"))
	    (org-switch-to-buffer-other-window " *Org todo*"))
	  (erase-buffer)
	  (setq-local org-done-keywords done-keywords)
	  (setq tbl fulltable cnt 0)
	  (while (setq e (pop tbl))
	    (cond
	     ((equal e '(:startgroup))
	      (push '() groups) (setq ingroup t)
	      (unless (= cnt 0)
		(setq cnt 0)
		(insert "\n"))
	      (setq prompt (concat prompt "{"))
	      (insert "{ "))
	     ((equal e '(:endgroup))
	      (setq ingroup nil cnt 0 in-current-sequence nil)
	      (setq prompt (concat prompt "}"))
	      (insert "}\n"))
	     ((equal e '(:newline))
	      (unless (= cnt 0)
		(setq cnt 0)
		(insert "\n")
		(setq e (car tbl))
		(while (equal (car tbl) '(:newline))
		  (insert "\n")
		  (setq tbl (cdr tbl)))))
	     (t
	      (setq tg (car e) c (cdr e))
	      (if (equal tg head) (setq in-current-sequence t))
	      (when ingroup (push tg (car groups)))
	      (when in-current-sequence (push e subtable))
	      (setq tg (org-add-props tg nil 'face
				      (org-get-todo-face tg)))
	      (when (and (= cnt 0) (not ingroup)) (insert "  "))
	      (setq prompt (concat prompt "[" (char-to-string c) "] " tg " "))
	      (insert "[" c "] " tg (make-string
				     (- fwidth 4 (length tg)) ?\ ))
	      (when (and (= (setq cnt (1+ cnt)) ncol)
			 ;; Avoid lines with just a closing delimiter.
			 (not (equal (car tbl) '(:endgroup))))
		(insert "\n")
		(when ingroup (insert "  "))
		(setq cnt 0)))))
	  (insert "\n")
	  (goto-char (point-min))
	  (unless expert (org-fit-window-to-buffer))
	  (message (concat "[a-z..]:Set [SPC]:clear"
			   (if expert (concat "\n" prompt) "")))
	  (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
	  (setq subtable (nreverse subtable))
	  (cond
	   ((or (= c ?\C-g)
		(and (= c ?q) (not (rassoc c fulltable))))
	    (setq quit-flag t))
	   ((= c ?\ ) nil)
	   ((setq e (or (rassoc c subtable) (rassoc c fulltable))
		  tg (car e))
	    tg)
	   (t (setq quit-flag t)))))))

  (defalias 'org-fast-todo-selection 'qrthi/org-fast-todo-selection)

  (org-clock-persistence-insinuate)
  )