planner-tasks-overview.el

   1 ;;; planner-tasks-overview.el --- Task summary for planner.el
   2 ;;
   3 ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
   4
   5 ;; Emacs Lisp Archive Entry
   6 ;; Filename: planner-tasks-overview.el
   7 ;; Keywords: hypermedia
   8 ;; Author: Sandra Jean Chua (Sacha) <sacha@free.net.ph>
   9 ;; Description: Task overview for planner.el files
  10 ;; URL: http://www.wjsullivan.net/PlannerMode.html
  11 ;; Compatibility: Emacs20, Emacs21
  12
  13 ;; This file is part of Planner.  It is not part of GNU Emacs.
  14
  15 ;; Planner is free software; you can redistribute it and/or modify it
  16 ;; under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 2, or (at your option)
  18 ;; any later version.
  19
  20 ;; Planner is distributed in the hope that it will be useful, but
  21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  23 ;; General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with Planner; see the file COPYING.  If not, write to the
  27 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  28 ;; Boston, MA 02110-1301, USA.
  29
  30 ;;;_ + Commentary:
  31
  32 ;; You can use `planner-tasks-overview' to see a list of tasks between
  33 ;; two dates. `planner-tasks-overview-jump' jumps to the linked task.
  34 ;; To change the sort order, invoke the following functions:
  35 ;; `planner-tasks-overview-sort-by-date'
  36 ;; `planner-tasks-overview-sort-by-plan'
  37 ;; `planner-tasks-overview-sort-by-category'
  38 ;; `planner-tasks-overview-sort-by-status'
  39 ;;
  40 ;; This file was inspired by Markus Hoenicka's
  41 ;; http://www.mhoenicka.de/software/hacks/tasklist.html and Frederick
  42 ;; Fouvry's Lisp port of tasklist.pl.
  43
  44 ;;;_ + Contributors
  45
  46 ;; Andrew J. Korty (ajk AT iu DOT edu) provided a patch that corrected
  47 ;; a typo in the keymap.
  48
  49 ;; Yann Hodique helped port this to Muse.
  50
  51 ;;; Code:
  52
  53 (require 'planner)
  54
  55 (defvar planner-tasks-overview-mode-map
  56   (let ((map (make-sparse-keymap)))
  57     (define-key map "1" 'planner-tasks-overview-sort-by-date)
  58     (define-key map "2" 'planner-tasks-overview-sort-by-plan)
  59     (define-key map "3" 'planner-tasks-overview-sort-by-priority)
  60     (define-key map "4" 'planner-tasks-overview-sort-by-status)
  61     (define-key map "j" 'planner-tasks-overview-jump)
  62     (define-key map "o" 'planner-tasks-overview)
  63
  64     (define-key map [tab] 'planner-next-reference)
  65     (define-key map [(control ?i)] 'planner-next-reference)
  66     (if (featurep 'xemacs)
  67         (define-key map [(shift tab)] 'planner-previous-reference)
  68       (define-key map [(shift iso-lefttab)] 'planner-previous-reference)
  69       (define-key map [(shift control ?i)] 'planner-previous-reference))
  70     map)
  71   "Keymap for planner task overview buffers.")
  72
  73 (define-derived-mode planner-tasks-overview-mode fundamental-mode "Overview"
  74   "Planner tasks overview.
  75 \\{planner-tasks-overview-mode-map}")
  76
  77 (defvar planner-tasks-overview-data nil "Task data.")
  78 (make-variable-buffer-local 'planner-tasks-overview-data)
  79 (defvar planner-tasks-overview-buffer "*planner tasks overview*"
  80   "Buffer name.")
  81
  82 ;;;###autoload
  83 (defun planner-tasks-overview (start end)
  84   "Display a task overview from START to END."
  85   (interactive (list (planner-read-date)
  86                      (planner-read-date)))
  87   (when (get-buffer planner-tasks-overview-buffer)
  88     (kill-buffer planner-tasks-overview-buffer))
  89   (with-current-buffer (get-buffer-create planner-tasks-overview-buffer)
  90     (planner-tasks-overview-mode)
  91     (setq planner-tasks-overview-data
  92           (planner-tasks-overview-extract-all-tasks
  93            (planner-get-day-pages start end)))
  94     (setq truncate-lines t)
  95     (set (make-local-variable 'truncate-partial-width-windows) t)
  96     (planner-tasks-overview-sort-by-date)
  97     (switch-to-buffer (current-buffer))))
  98
  99 ;;;###autoload
 100 (defun planner-tasks-overview-jump-other-window ()
 101   "Display the task under point in a different window."
 102   (interactive)
 103   (planner-tasks-overview-jump t))
 104
 105 ;;;###autoload
 106 (defun planner-tasks-overview-jump (&optional other-window)
 107   "Display the task under point."
 108   (interactive "P")
 109   (when other-window
 110     (switch-to-buffer-other-window (current-buffer)))
 111   (let* ((info (get-text-property (point) 'info))
 112          (page (or (elt info 2) (elt info 3))))
 113     (planner-find-file page)
 114     (goto-char (point-min))
 115     (widen)
 116     (when (re-search-forward
 117            (concat
 118             "#[A-C][0-9]*\\s-+.\\s-+"
 119             (regexp-quote (elt info 4))) nil t)
 120       (goto-char (planner-line-beginning-position)))))
 121
 122 (defun planner-tasks-overview-sort-by-field (field)
 123   "Sort by FIELD."
 124   (interactive)
 125   (setq planner-tasks-overview-data
 126         (sort planner-tasks-overview-data
 127               (lambda (a b) (string< (elt a field) (elt b field)))))
 128   (planner-tasks-overview-insert))
 129
 130 (defun planner-tasks-overview-sort-by-date ()
 131   "Sort by date."
 132   (interactive)
 133   (planner-tasks-overview-sort-by-field 2))
 134
 135 (defun planner-tasks-overview-sort-by-plan ()
 136   "Sort by plan."
 137   (interactive)
 138   (planner-tasks-overview-sort-by-field 3))
 139
 140 (defun planner-tasks-overview-sort-by-priority ()
 141   "Sort by plan."
 142   (interactive)
 143   (planner-tasks-overview-sort-by-field 0))
 144
 145 (defun planner-tasks-overview-sort-by-status ()
 146   "Sort by status."
 147   (interactive)
 148   (setq planner-tasks-overview-data
 149         (sort planner-tasks-overview-data
 150               (lambda (a b)
 151                 (if (string= (elt b 1)
 152                              (elt a 1))
 153                     (string< (elt a 0)
 154                              (elt b 0))
 155                   (member (elt b 1)
 156                           (member (elt a 1)
 157                                   '("_" "o" "D" "P" "X" "C")))))))
 158   (planner-tasks-overview-insert))
 159
 160 (defun planner-tasks-overview-insert ()
 161   "Insert the textual representation for `planner-tasks-overview-data'.
 162 DATA is a list of (priority status date plan description)."
 163   (with-current-buffer (get-buffer-create "*planner tasks overview*")
 164     (setq buffer-read-only nil)
 165     (erase-buffer)
 166     (let (last-date last-plan)
 167       (mapcar
 168        (lambda (item)
 169          (let ((text
 170                 (format "%10s | %s | %s %s | %s\n"
 171                         (if (elt item 2)
 172                             (planner-make-link
 173                              (elt item 2)
 174                              (format "%-10.10s"
 175                                      (if (string= last-date (elt item 2))
 176                                          "__________"
 177                                        (elt item 2))))
 178                           (format "%-10.10s" "nil"))
 179                         (if (elt item 3)
 180                             (planner-make-link
 181                              (elt item 3)
 182                              (format "%-20.20s"
 183                                      (if (string= last-plan (elt item 3))
 184                                          "____________________"
 185                                        (elt item 3))))
 186                           (format "%-20.20s" "nil"))
 187                         (elt item 0)
 188                         (elt item 1)
 189                         (elt item 4))))
 190            (add-text-properties 0 (length text) (list 'info item)
 191                                 text)
 192            (insert text))
 193          (setq last-date (elt item 2))
 194          (setq last-plan (elt item 3)))
 195        planner-tasks-overview-data)
 196       (planner-mode)
 197       (goto-char (point-min))
 198       (setq buffer-read-only t))))
 199
 200 (defun planner-tasks-overview-extract-all-tasks (file-list)
 201   "Return a list of all tasks on pages in FILE-LIST."
 202   (let (results)
 203     (with-temp-buffer
 204       (cd (planner-directory))
 205       ;; The following line greps only the days limited by START and END.
 206       (apply 'call-process "grep" nil t nil "-H" "-e" "^#[A-C][0-9]*"
 207              (mapcar 'cdr file-list))
 208       (goto-char (point-min))
 209       (while (not (eobp))
 210         (when (looking-at "^\\([^:\n]+\\):\\(.+\\)")
 211           (let ((info (planner-task-info-from-string
 212                        (match-string 1) (match-string 2))))
 213             (add-to-list
 214              'results
 215              (vector (planner-task-priority info)
 216                      (planner-task-status info)
 217                      (planner-task-date info)
 218                      (planner-task-plan info)
 219                      (planner-task-description info)))))
 220         (forward-line))
 221       results)))
 222
 223 ;; Improvements: sort?
 224 ;;;###autoload
 225 (defun planner-tasks-overview-show-summary (&optional file-list)
 226   "Count unscheduled, scheduled, and completed tasks for FILE-LIST.
 227 If called with an interactive prefix, prompt for the page(s) to
 228 display. planner-multi is required for multiple pages."
 229   (interactive
 230    (list
 231     (if current-prefix-arg
 232         (planner-file-alist
 233          nil
 234          (if (featurep 'planner-multi)
 235              (mapcar 'planner-link-base
 236                      (planner-multi-split
 237                       (planner-read-non-date-page
 238                        (planner-file-alist))))
 239            (list (planner-read-non-date-page
 240                   (planner-file-alist))))))))
 241   (let (data total)
 242     (with-planner
 243       (setq data (planner-tasks-overview-get-summary file-list))
 244       (with-current-buffer (get-buffer-create "*planner tasks overview*")
 245         (setq buffer-read-only nil)
 246         (erase-buffer)
 247         (setq total (+ (elt data 0) (elt data 1) (elt data 2)))
 248         (insert (format "Total unfinished, unscheduled tasks : %3d (%6.2f%%)\n"
 249                         (elt data 0) (/ (elt data 0) (* 0.01 total)))
 250                 (format "Total unfinished, scheduled tasks   : %3d (%6.2f%%)\n"
 251                         (elt data 1) (/ (elt data 1) (* 0.01 total)))
 252                 (format "Total finished tasks                : %3d (%6.2f%%)\n\n"
 253                         (elt data 2) (/ (elt data 2) (* 0.01 total))))
 254         (insert (format "%-40s | Unsched  |  Sched   | Complete | Total\n"
 255                         "Plan page"))
 256         (mapcar
 257          (lambda (row)
 258            (let ((row-total (* 0.01 (+ (elt row 1) (elt row 2) (elt row 3)))))
 259              (insert
 260               (format "%s | %3d %3.0f%% | %3d %3.0f%% | %3d %3.0f%% | %3d %3.0f%%\n"
 261                       (planner-make-link
 262                        (elt row 0)
 263                        (format "%-40.40s" (elt row 0)))
 264                       (elt row 1)
 265                       (/ (elt row 1) row-total)
 266                       (elt row 2)
 267                       (/ (elt row 2) row-total)
 268                       (elt row 3)
 269                       (/ (elt row 3) row-total)
 270                       (+ (elt row 1) (elt row 2) (elt row 3))
 271                       (/ (+ (elt row 1) (elt row 2) (elt row 3))
 272                          (* 0.01 total))))))
 273          (elt data 3))
 274         (cd (planner-directory))
 275         (planner-mode)
 276         (switch-to-buffer (current-buffer))))))
 277
 278 ;; Unfinished                Finished      % Complete
 279 ;; Unscheduled   Scheduled
 280 (defun planner-tasks-overview-get-summary (&optional file-list)
 281   "Return a summary of tasks on pages in FILE-LIST.
 282 List is of the form (total-unfinished-unscheduled
 283 total-unfinished-scheduled total-finished data), where data is a
 284 list of the form (plan unfinished-unscheduled
 285 unfinished-scheduled finished)."
 286   (let ((total-unfinished-unscheduled 0)
 287         (total-unfinished-scheduled 0)
 288         (total-finished 0)
 289         list)
 290     (unless file-list (setq file-list (planner-file-alist)))
 291     (with-temp-buffer
 292       (with-planner
 293         (while file-list
 294           (unless (string-match planner-date-regexp (car (car file-list)))
 295             (let ((unfinished-unscheduled 0)
 296                   (unfinished-scheduled 0)
 297                   (finished 0))
 298               (erase-buffer)
 299               (insert-file-contents (cdr (car file-list)))
 300               (goto-char (point-min))
 301               (while (re-search-forward planner-task-regexp nil t)
 302                 (let ((info (planner-task-info-from-string
 303                              (car (car file-list))
 304                              (buffer-substring
 305                               (planner-line-beginning-position)
 306                               (planner-line-end-position)))))
 307                   (cond
 308                    ((or (string= (planner-task-status info) "X")
 309                         (string= (planner-task-status info) "C"))
 310                     (setq finished (1+ finished)))
 311                    ((planner-task-date info)
 312                     (setq unfinished-scheduled (1+ unfinished-scheduled)))
 313                    (t (setq unfinished-unscheduled
 314                             (1+ unfinished-unscheduled))))))
 315               (setq list (cons (list (car (car file-list))
 316                                      unfinished-unscheduled
 317                                      unfinished-scheduled
 318                                       finished)
 319                                 list))
 320                (setq total-unfinished-unscheduled
 321                      (+ total-unfinished-unscheduled unfinished-unscheduled))
 322                (setq total-unfinished-scheduled
 323                      (+ total-unfinished-scheduled unfinished-scheduled))
 324                (setq total-finished
 325                      (+ total-finished finished))))
 326           (setq file-list (cdr file-list)))))
 327     (list total-unfinished-unscheduled
 328           total-unfinished-scheduled
 329           total-finished
 330           list)))
 331
 332 (provide 'planner-tasks-overview)
 333
 334 ;;; planner-tasks-overview.el ends here