howm-reminder.el

   1 ;;; howm-reminder.el --- Wiki-like note-taking tool
   2 ;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2015, 2016
   3 ;;;   HIRAOKA Kazuyuki <khi@users.sourceforge.jp>
   4 ;;; $Id: howm-reminder.el,v 1.83 2012-12-29 08:57:18 hira Exp $
   5 ;;;
   6 ;;; This program is free software; you can redistribute it and/or modify
   7 ;;; it under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 1, or (at your option)
   9 ;;; any later version.
  10 ;;;
  11 ;;; This program is distributed in the hope that it will be useful,
  12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; The GNU General Public License is available by anonymouse ftp from
  17 ;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
  18 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
  19 ;;; USA.
  20 ;;--------------------------------------------------------------------
  21
  22 (provide 'howm-reminder)
  23 (require 'howm)
  24
  25 (defvar howm-list-schedule-name "{schedule}")
  26 (defvar howm-list-todo-name "{todo}")
  27 ;   "This is used for buffer name of `howm-list-reminder'.
  28 ; See `howm-view-summary-name'.")
  29
  30 (howm-defvar-risky howm-todo-priority-func
  31       '(("-" . howm-todo-priority-normal)
  32         (" " . howm-todo-priority-normal)
  33         ("+" . howm-todo-priority-todo)
  34         ("~" . howm-todo-priority-defer)
  35         ("!" . howm-todo-priority-deadline)
  36         ("@" . howm-todo-priority-schedule)
  37         ("." . howm-todo-priority-done)))
  38 (defvar howm-todo-priority-normal-laziness 1)
  39 (defvar howm-todo-priority-todo-laziness 7)
  40 (defvar howm-todo-priority-todo-init -7)
  41 (defvar howm-todo-priority-defer-laziness 30)
  42 (defvar howm-todo-priority-defer-init -14)
  43 (defvar howm-todo-priority-defer-peak 0)
  44 (defvar howm-todo-priority-deadline-laziness 7)
  45 (defvar howm-todo-priority-deadline-init -2)
  46 (defvar howm-todo-priority-schedule-laziness 1)
  47 (defvar howm-todo-priority-normal-bottom   (- howm-huge))
  48 (defvar howm-todo-priority-todo-bottom     (- howm-huge))
  49 (defvar howm-todo-priority-defer-bottom    (- howm-huge))
  50 (defvar howm-todo-priority-deadline-bottom (- howm-huge))
  51 (defvar howm-todo-priority-schedule-bottom (- howm-huge++)
  52   "Base priority of schedules in the bottom.
  53 Its default value is extremely negative so that you never see
  54 schedules outside the range in %reminder in the menu.")
  55 (defvar howm-todo-priority-deadline-top    howm-huge)
  56 (defvar howm-todo-priority-schedule-top    howm-huge)
  57 (defvar howm-todo-priority-unknown-top     howm-huge+)
  58
  59 (defvar howm-action-lock-reminder-done-default nil)
  60
  61 (defvar howm-congrats-count 0)
  62
  63 ;;; --- level ? ---
  64
  65 ;; Fix me: redundant (howm-date-* & howm-reminder-*)
  66
  67 ;; (defun howm-reminder-regexp-grep (types)
  68 ;;   (howm-inhibit-warning-in-compilation))
  69 ;; (defun howm-reminder-regexp (types)
  70 ;;   (howm-inhibit-warning-in-compilation))
  71
  72 (if howm-reminder-old-format
  73     (progn ;; old format
  74       (defvar howm-reminder-regexp-grep-format
  75         "@\\[[0-9][0-9][0-9][0-9]/[0-9][0-9]/[0-9][0-9]\\]%s")
  76       (defvar howm-reminder-regexp-format
  77         "\\(@\\)\\[\\([0-9][0-9][0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9]\\)\\]\\(%s\\)\\([0-9]*\\)")
  78       (defun howm-reminder-regexp-grep (types)
  79         (format howm-reminder-regexp-grep-format types))
  80       (defun howm-reminder-regexp (types)
  81         (format howm-reminder-regexp-format types))
  82       (defvar howm-reminder-regexp-command-pos 1)
  83       (defvar howm-reminder-regexp-year-pos 2)
  84       (defvar howm-reminder-regexp-month-pos 3)
  85       (defvar howm-reminder-regexp-day-pos 4)
  86       (defvar howm-reminder-regexp-type-pos 5)
  87       (defvar howm-reminder-regexp-laziness-pos 6)
  88       (defvar howm-reminder-today-format "@[%Y/%m/%d]")
  89       (howm-defvar-risky howm-reminder-font-lock-keywords
  90         `(
  91           (,(howm-reminder-regexp "[-]?") (0 howm-reminder-normal-face prepend))
  92           (,(howm-reminder-regexp "[+]") (0 howm-reminder-todo-face prepend))
  93           (,(howm-reminder-regexp "[~]") (0 howm-reminder-defer-face prepend))
  94           (,(howm-reminder-regexp "[!]")
  95            (0 howm-reminder-deadline-face prepend)
  96            (,howm-reminder-regexp-type-pos (howm-reminder-deadline-type-face) prepend))
  97           (,(howm-reminder-regexp "[@]") (0 howm-reminder-schedule-face prepend))
  98           (,(howm-reminder-regexp "[.]") (0 howm-reminder-done-face prepend))
  99           ))
 100       (defun howm-reminder-font-lock-keywords ()
 101         howm-reminder-font-lock-keywords)
 102       (defun howm-action-lock-done (&optional command)
 103         (save-excursion
 104           (let ((at-beg (match-beginning howm-reminder-regexp-command-pos))
 105                 (at-end (match-end  howm-reminder-regexp-command-pos))
 106                 (type-beg (match-beginning howm-reminder-regexp-type-pos))
 107                 (type-end (match-end howm-reminder-regexp-type-pos))
 108                 (lazy-beg (match-beginning howm-reminder-regexp-laziness-pos))
 109                 (lazy-end (match-end howm-reminder-regexp-laziness-pos)))
 110             (let* ((s (or command
 111                           (read-from-minibuffer
 112                            "RET (done), x (cancel), symbol (type), num (laziness): ")))
 113                    (c (cond ((string= s "") ".")
 114                             ((= 0 (string-to-number s)) ". give up")
 115                             (t nil))))
 116               (when (string= s "")
 117                 (howm-congrats))
 118               (if c
 119                   (progn
 120                     (goto-char at-beg)
 121                     (delete-region at-beg at-end)
 122                     (insert (howm-reminder-today))
 123                     (insert (format "%s " c)))
 124                 (progn
 125                   (goto-char lazy-beg)
 126                   (delete-region lazy-beg lazy-end)
 127                   (when (string= (buffer-substring-no-properties type-beg type-end)
 128                                  " ")
 129                     (goto-char type-beg)
 130                     (insert "-")) ;; "no type" = "normal"
 131                   (insert s)))))))
 132       )
 133   (progn ;; new format
 134     (defvar howm-reminder-regexp-grep-format
 135       (concat "\\[" howm-date-regexp-grep "[ :0-9]*\\]%s"))
 136     (defvar howm-reminder-regexp-format
 137       (concat "\\(\\[" howm-date-regexp "[ :0-9]*\\]\\)\\(\\(%s\\)\\([0-9]*\\)\\)"))
 138 ;;     (defvar howm-reminder-regexp-grep-format
 139 ;;       (concat "\\[" howm-date-regexp-grep "\\]%s"))
 140 ;;     (defvar howm-reminder-regexp-format
 141 ;;       (concat "\\[" howm-date-regexp "\\]\\(\\(%s\\)\\([0-9]*\\)\\)"))
 142     (defun howm-reminder-regexp-grep (types)
 143       (format howm-reminder-regexp-grep-format types))
 144     (defun howm-reminder-regexp (types)
 145       (format howm-reminder-regexp-format types))
 146     (defvar howm-reminder-regexp-date-pos 1)
 147     (defvar howm-reminder-regexp-year-pos  (+ howm-date-regexp-year-pos 1))
 148     (defvar howm-reminder-regexp-month-pos (+ howm-date-regexp-month-pos 1))
 149     (defvar howm-reminder-regexp-day-pos   (+ howm-date-regexp-day-pos 1))
 150     (defvar howm-reminder-regexp-command-pos 5)
 151     (defvar howm-reminder-regexp-type-pos 6)
 152     (defvar howm-reminder-regexp-laziness-pos 7)
 153     (defvar howm-reminder-today-format
 154       (format howm-insert-date-format howm-date-format))
 155     (howm-defvar-risky howm-reminder-font-lock-keywords
 156       `(
 157         (,(howm-reminder-regexp "[-]") (0 howm-reminder-normal-face prepend))
 158         (,(howm-reminder-regexp "[+]") (0 howm-reminder-todo-face prepend))
 159         (,(howm-reminder-regexp "[~]") (0 howm-reminder-defer-face prepend))
 160         (,(howm-reminder-regexp "[!]")
 161          (0 howm-reminder-deadline-face prepend)
 162          (,howm-reminder-regexp-type-pos (howm-reminder-deadline-type-face) prepend))
 163         (,(howm-reminder-regexp "[@]") (0 howm-reminder-schedule-face prepend))
 164         (,(howm-reminder-regexp "[.]") (0 howm-reminder-done-face prepend))
 165         ))
 166     (defun howm-reminder-font-lock-keywords ()
 167       howm-reminder-font-lock-keywords)
 168     (defun howm-action-lock-done-prompt ()
 169       (format "RET (done), x (%s), symbol (type), num (laziness): "
 170               howm-reminder-cancel-string))
 171     (defun howm-action-lock-done (&optional command)
 172       ;; parse line
 173       (let* ((pos (point))
 174              (beg (match-beginning 0))
 175              (end (match-end 0))
 176              (date (match-string-no-properties howm-reminder-regexp-date-pos))
 177              (type (match-string-no-properties howm-reminder-regexp-type-pos))
 178              (lazy (match-string-no-properties howm-reminder-regexp-laziness-pos))
 179              (desc (buffer-substring-no-properties end (line-end-position))))
 180         ;; parse input command
 181         (let* ((s (or command
 182                       (howm-read-string (howm-action-lock-done-prompt)
 183                                         "x-+~!.@"
 184                                         "0123456789")))
 185                (type-or-lazy (string-match (format "^\\(%s?\\)\\([0-9]*\\)$"
 186                                                    howm-reminder-types)
 187                                            s))
 188                (new-type (and type-or-lazy (match-string-no-properties 1 s)))
 189                (new-lazy (and type-or-lazy (match-string-no-properties 2 s))))
 190           (when (string= new-type "")
 191             (setq new-type type))
 192           (when (string= new-lazy "")
 193             (setq new-lazy lazy))
 194           ;; dispatch and get new contents
 195           (let ((new (cond ((string= s "")
 196                             (howm-action-lock-done-done date type lazy desc))
 197                            ((string= s "x")
 198                             (howm-action-lock-done-cancel date type lazy
 199                                                           desc))
 200                            (type-or-lazy
 201                             (howm-action-lock-done-modify date
 202                                                           new-type new-lazy
 203                                                           desc))
 204                            (t
 205                             (error "Can't understand %s" s)))))
 206             ;; replace contents
 207             (goto-char beg)
 208             (delete-region (point) (line-end-position))
 209             (insert new)
 210             (goto-char pos)))))
 211     (defun howm-action-lock-done-done (date type lazy desc &optional done-mark)
 212       (when (null done-mark)
 213         (setq done-mark ".")
 214         (howm-congrats))
 215       (concat (howm-reminder-today) done-mark " "
 216               date ":" type lazy desc))
 217     (defun howm-action-lock-done-cancel (date type lazy desc)
 218       (howm-action-lock-done-done date type lazy desc
 219                                   (format ". %s" howm-reminder-cancel-string)))
 220     (defun howm-action-lock-done-modify (date type lazy desc)
 221       (concat date type lazy desc))
 222     ))
 223
 224 (defun howm-reminder-deadline-type-face ()
 225   (let ((late (cadr (howm-todo-parse-string (match-string-no-properties 0)))))
 226     (if (>= late 0)
 227         howm-reminder-late-deadline-face
 228       howm-reminder-deadline-face)))
 229
 230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 231 ;; Reminder: schedule & todo
 232
 233 (define-key howm-view-summary-mode-map "." 'howm-reminder-goto-today)
 234
 235 ;; Clean me.
 236 ;; I cannot remember why I wrote howm-with-schedule-summary-format.
 237 (defmacro howm-with-schedule-summary-format (&rest body)
 238   (declare (indent 0))
 239   `(let ((howm-view-summary-format (if howm-view-split-horizontally ;; dirty!
 240                                       ""
 241                                     howm-view-summary-format)))
 242      ,@body))
 243
 244 (defun howm-list-schedule ()
 245   (interactive)
 246   (howm-with-need
 247     (howm-with-schedule-summary-format
 248       (let ((items (need (howm-list-reminder-internal howm-schedule-types))))
 249         (howm-list-reminder-final-setup howm-list-schedule-name
 250                                         (howm-schedule-sort-items items)))
 251       (howm-reminder-goto-today)
 252       (howm-view-summary-check))))
 253
 254 (defun howm-list-reminder-internal (types)
 255   (let* ((r (howm-reminder-regexp types))
 256          (rg (howm-reminder-regexp-grep types))
 257          (summarizer (howm-reminder-summarizer r t))
 258          (folder (howm-reminder-search-path-folder)))
 259     (cl-caddr (howm-view-search-folder-internal rg folder nil summarizer))))
 260
 261 (defun howm-list-reminder-final-setup (&optional name item-list)
 262   (howm-view-summary name item-list
 263                      (append (howm-reminder-add-font-lock-internal)
 264                              (howm-mode-add-font-lock-internal)))
 265   (let ((action-lock-default-rules
 266          (howm-action-lock-reminder-forward-rules t)))
 267     (action-lock-mode t)))
 268
 269 (let ((rs (mapcar #'regexp-quote
 270                   (list howm-date-format howm-reminder-today-format))))
 271   (defcustom howm-highlight-date-regexp-format (car rs)
 272     "Time format for highlight of today and tommorow.
 273 This value is passed to `format-time-string', and the result must be a regexp."
 274     :type `(radio ,@(mapcar (lambda (r) `(const ,r)) rs)
 275                     string)
 276     :group 'howm-faces))
 277
 278 (defun howm-reminder-today-font-lock-keywords ()
 279   (let ((today    (howm-reminder-today 0 howm-highlight-date-regexp-format))
 280         (tomorrow (howm-reminder-today 1 howm-highlight-date-regexp-format)))
 281     `((,today (0 howm-reminder-today-face prepend))
 282       (,tomorrow (0 howm-reminder-tomorrow-face prepend)))))
 283
 284 (defun howm-reminder-add-font-lock ()
 285   (cheat-font-lock-append-keywords (howm-reminder-add-font-lock-internal)))
 286
 287 (defun howm-reminder-add-font-lock-internal ()
 288   (append (howm-reminder-font-lock-keywords)
 289           (howm-reminder-today-font-lock-keywords)))
 290
 291 (defun howm-reminder-omit-before (regexp str)
 292   (string-match regexp str)
 293   (substring str (match-beginning 0)))
 294
 295 (defun howm-reminder-summarizer (regexp &optional show-day-of-week)
 296   `(lambda (file line content)
 297      (let ((s (howm-reminder-omit-before ,regexp content)))
 298 ;;                 (string-match ,regexp content)
 299 ;;                 (substring content (match-beginning 0)))))
 300        ,(if show-day-of-week
 301             '(let* ((p (howm-todo-parse-string s))
 302                     (late (floor (nth 1 p)))
 303                     (dow (howm-day-of-week-string (nth 4 p))))
 304                (format "%s%3s %s" dow late s))
 305           's))))
 306
 307 (defun howm-reminder-today (&optional days-after fmt)
 308   (format-time-string (or fmt howm-reminder-today-format)
 309                       (howm-days-after (current-time) (or days-after 0))))
 310
 311 ;; dirty. peek howm-view-*
 312 (defun howm-reminder-goto-today ()
 313   (interactive)
 314   (let* ((today (howm-reminder-today))
 315          (r (howm-reminder-regexp "."))
 316          (summaries (mapcar (lambda (item)
 317                               (howm-reminder-omit-before
 318                                r (howm-view-item-summary item)))
 319                            (howm-view-item-list))))
 320 ;;         (summaries (mapcar 'howm-view-item-summary (howm-view-item-list))))
 321     (let ((rest summaries)
 322           (n 0))
 323       (while (and rest
 324                   (string< (car rest) today))
 325         (setq rest (cdr rest)
 326               n (1+ n)))
 327       (howm-goto-line (1+ n)))))
 328
 329 (defun howm-schedule-menu (days &optional days-before)
 330   (let* ((today (howm-encode-day t))
 331          (from (- today (or days-before 0)))
 332          (to (+ today days 1))
 333          (howm-schedule-types howm-schedule-menu-types)  ;; dirty
 334          (raw (howm-reminder-search howm-schedule-types))
 335          (filtered (cl-remove-if #'(lambda (item)
 336                                           (let ((s (howm-schedule-date item)))
 337                                             (or (< s from)
 338                                                 (< to s))))
 339                                       raw)))
 340     (howm-schedule-sort-items filtered)))
 341
 342 (defun howm-schedule-sort-items (items &optional reverse-p)
 343   (when reverse-p
 344     (error "Not supported."))
 345   (howm-with-schedule-summary-format
 346     (howm-sort #'howm-schedule-sort-converter #'howm-schedule-sort-comparer
 347                items)))
 348 (defun howm-schedule-sort-by-date ()
 349   (interactive)
 350   (howm-view-sort-doit #'howm-schedule-sort-items))
 351 (defun howm-schedule-sort-converter (item)
 352   (let ((z (howm-reminder-parse item)))
 353     (cons (car z)
 354           (if howm-schedule-sort-by-time
 355               (howm-item-summary item)
 356             (nth 5 z)))))
 357 (defun howm-schedule-sort-comparer (a b)
 358   (if (= (car a) (car b))
 359       (string< (cdr a) (cdr b))
 360     (< (car a) (car b))))
 361
 362 (defun howm-schedule-date (item)
 363   (car (howm-reminder-parse item)))
 364
 365 (defun howm-reminder-search (types)
 366   (let* ((r (howm-reminder-regexp types))
 367          (rg (howm-reminder-regexp-grep types))
 368          (summarizer (howm-reminder-summarizer r))
 369          (folder (howm-reminder-search-path-folder)))
 370     (howm-view-search-folder-items rg folder summarizer)))
 371
 372 (defun howm-list-todo ()
 373   (interactive)
 374   (howm-list-todo-sub))
 375
 376 ;; experimental [2006-06-26]
 377 (defun howm-todo-sleeping-p (item)
 378   ;; (- howm-huge-) should be replaced with an appropreate variable.
 379   (< (howm-todo-priority item) (- howm-huge-)))
 380 (defun howm-list-active-todo ()
 381   (interactive)
 382   (howm-list-todo-sub (lambda (item)
 383                         (not (howm-todo-sleeping-p item)))))
 384 (defun howm-list-sleeping-todo ()
 385   (interactive)
 386   (howm-list-todo-sub #'howm-todo-sleeping-p))
 387
 388 (defun howm-list-todo-sub (&optional pred)
 389   (howm-with-need
 390     (howm-with-schedule-summary-format
 391       (let ((items (need (howm-list-reminder-internal howm-todo-types))))
 392         (when pred
 393           (setq items
 394                 (need (cl-remove-if-not pred items))))
 395         (setq items (howm-todo-sort-items items))
 396         (when howm-todo-separators
 397           (setq items
 398                 (howm-todo-insert-separators items
 399                                              howm-todo-separators)))
 400       (howm-list-reminder-final-setup howm-list-todo-name items)))))
 401
 402 (defun howm-todo-menu (n limit-priority separators)
 403   "Find top N todo items, or all todo items if N is nil.
 404 Returned value is a sorted list of items (see `howm-make-item').
 405 Items whose priority is worse than LIMIT-PRIORITY are eliminated.
 406 Separator strings are inserted to the returned list according to
 407 the rule given as SEPARATORS.
 408 See docstring of the variable `howm-menu-reminder-separators' for details."
 409   (let* ((cutted (cl-remove-if (lambda (item)
 410                                       (< (howm-todo-priority item)
 411                                          limit-priority))
 412                                     (howm-reminder-search howm-todo-menu-types)))
 413          (sorted (howm-todo-sort-items cutted)))
 414     (howm-todo-insert-separators (if n (howm-first-n sorted n) sorted)
 415                                  separators t)))
 416
 417 (defun howm-reminder-menu (n limit-priority separators)
 418   (howm-with-reminder-setting
 419     (howm-todo-menu n limit-priority separators)))
 420
 421 (defun howm-todo-insert-separators (item-list separators
 422                                               &optional relative-date-p)
 423   (let ((is (mapcar (lambda (item) (cons (howm-todo-priority item) item))
 424                     item-list))
 425         (sep (mapcar (lambda (pair)
 426                        (cons (if relative-date-p
 427                                  (- howm-todo-priority-schedule-top
 428                                     (or (car pair) howm-huge-))
 429                                (or (car pair) (- howm-huge-)))
 430                              (howm-make-item (howm-make-page:nil) (cdr pair))))
 431                      separators)))
 432     (mapcar #'cdr
 433             (sort (append is sep) #'(lambda (x y) (> (car x) (car y)))))))
 434
 435 (defun howm-todo-sort-items (items &optional reverse-p)
 436   (when reverse-p
 437     (error "Not supported."))
 438   (howm-sort #'howm-todo-priority-ext #'howm-todo-priority-ext-gt
 439              items))
 440
 441 (defun howm-todo-sort-by-priority ()
 442   (howm-view-sort-doit #'howm-todo-sort-items))
 443
 444 ;; Clean me.
 445 (defun howm-reminder-parse (item)
 446   (howm-todo-parse-string (howm-view-item-summary item)))
 447 (defun howm-todo-parse (item)
 448   (cdr (howm-reminder-parse item)))
 449 (defun howm-todo-parse-string (str)
 450   "Parse reminder format.
 451 Example: (howm-todo-parse-string \"abcde [2004-11-04]@ hogehoge\")
 452 ==> (12725.625 0.022789351851315587 \"@\" nil 4 \" hogehoge\")"
 453   (let ((summary str))
 454     (string-match (howm-reminder-regexp ".") summary)
 455     (let ((y (match-string-no-properties howm-reminder-regexp-year-pos
 456                                          summary))
 457           (m (match-string-no-properties howm-reminder-regexp-month-pos
 458                                          summary))
 459           (d (match-string-no-properties howm-reminder-regexp-day-pos
 460                                          summary))
 461           (ty (match-string-no-properties howm-reminder-regexp-type-pos
 462                                           summary))
 463           (lz (match-string-no-properties howm-reminder-regexp-laziness-pos
 464                                           summary))
 465           (description (substring str (match-end 0))))
 466       (let* ((day (howm-encode-day d m y))
 467              (today (howm-encode-day))
 468              (late (- today day))
 469              (type (substring (or ty "-") 0 1)) ;; "-" for old format
 470              (lazy (cond ((string= type " ") nil)
 471                          ((null lz) nil)
 472                          (t (let ((z (string-to-number lz)))
 473                               (if (= z 0) nil z)))))
 474              ;;            (lazy (if (string= type " ")
 475              ;;                      0
 476              ;;                    (string-to-number (or lz "0"))))
 477              (day-of-week (nth 6
 478                                (decode-time (apply #'encode-time
 479                                                    (mapcar #'string-to-number
 480                                                            (list "0" "0" "0"
 481                                                                  d m y)))))))
 482         (list day late type lazy day-of-week description)))))
 483
 484 (defun howm-todo-priority (item)
 485   (let* ((p (howm-todo-parse item))
 486          (late (car p))
 487          (type (cadr p))
 488          (lazy (cl-caddr p))
 489          (f (or (cdr (assoc type howm-todo-priority-func))
 490                 #'howm-todo-priority-unknown)))
 491     (funcall f late lazy item)))
 492
 493 (defun howm-todo-priority-ext (item)
 494   (cons (howm-todo-priority item) (howm-view-item-summary item)))
 495 (defun howm-todo-priority-ext-gt (e1 e2)
 496   "Compare two results E1 and E2 of `howm-todo-priority-ext'.
 497 Return true if E1 has higher priority than E2."
 498   (cond ((> (car e1) (car e2)) t)
 499         ((< (car e1) (car e2)) nil)
 500         (t (string< (cdr e1) (cdr e2)))))
 501
 502 (defun howm-todo-relative-late (late laziness default-laziness)
 503   (/ late (float (or laziness default-laziness))))
 504
 505 (defun howm-todo-priority-normal (late lz item)
 506   (let ((r (howm-todo-relative-late late lz
 507                                     howm-todo-priority-normal-laziness)))
 508     (cond ((< r 0) (+ r howm-todo-priority-normal-bottom))
 509           (t (- r)))))
 510
 511 (defun howm-todo-priority-todo (late lz item)
 512   (let ((r (howm-todo-relative-late late lz
 513                                     howm-todo-priority-todo-laziness))
 514         (c (- howm-todo-priority-todo-init)))
 515     (cond ((< r 0) (+ r howm-todo-priority-todo-bottom))
 516           (t (* c (- r 1))))))
 517
 518 (defun howm-todo-priority-defer (late lz item)
 519   (let* ((r (howm-todo-relative-late late lz
 520                                      howm-todo-priority-defer-laziness))
 521          (p howm-todo-priority-defer-peak)
 522          (c (- p howm-todo-priority-defer-init)))
 523     (let ((v (* 2 (abs (- (mod r 1) 0.5)))))
 524       (cond ((< r 0) (+ r howm-todo-priority-defer-bottom))
 525             (t (- p (* c v)))))))
 526
 527 ;; ;; Clean me.
 528 ;; (defvar howm-todo-schedule-days nil)
 529 ;; (defvar howm-todo-schedule-days-before nil)
 530 ;; (defmacro howm-with-schedule-days (days days-before &rest body)
 531 ;;   `(let ((howm-todo-schedule-days ,days)
 532 ;;          (howm-todo-schedule-days-before ,days-before))
 533 ;;     ,@body))
 534 ;; (put 'howm-with-schedule-days 'lisp-indent-hook 2)
 535 ;; (defun howm-todo-priority-schedule (late lz item)
 536 ;;   (setq lz (or lz howm-todo-priority-schedule-laziness))
 537 ;;   (cond ((< late (- howm-todo-schedule-days))
 538 ;;          (+ late howm-todo-priority-schedule-bottom))
 539 ;;         ((< late (+ lz howm-todo-schedule-days-before))
 540 ;;          (+ late howm-todo-priority-schedule-top))
 541 ;;         (t
 542 ;;          (+ late howm-todo-priority-schedule-bottom))))
 543
 544 (defun howm-todo-priority-deadline (late lz item)
 545   (if howm-reminder-schedule-interval
 546       (howm-todo-priority-deadline-1 late lz item)
 547     (howm-todo-priority-deadline-2 late lz item)))
 548
 549 (defun howm-todo-priority-deadline-1 (late lz item)
 550   (let ((r (howm-todo-relative-late late lz
 551                                     howm-todo-priority-deadline-laziness))
 552         (c (- howm-todo-priority-deadline-init))
 553         (d (- (howm-reminder-schedule-interval-to)))
 554         (top howm-todo-priority-deadline-top)
 555         (bot howm-todo-priority-deadline-bottom))
 556     ;; I dare to use late in the first case below so that
 557     ;; deadline behaves like schedule after its deadline date.
 558     (cond ((< d late) (+ top late))
 559           ((< r -1) (+ bot r))
 560           (t (* c r)))))
 561
 562 (defun howm-todo-priority-deadline-2 (late lz item)
 563   "This function may be obsolete in future.
 564 `howm-todo-priority-deadline-1' will be used instead."
 565   (let ((r (howm-todo-relative-late late lz
 566                                     howm-todo-priority-deadline-laziness))
 567         (c (- howm-todo-priority-deadline-init)))
 568     (cond ((> r 0) (+ r howm-todo-priority-deadline-top))
 569           ((< r -1) (+ r howm-todo-priority-deadline-bottom))
 570           (t (* c r)))))
 571
 572 (defun howm-todo-priority-schedule (late lz item)
 573   (if howm-reminder-schedule-interval
 574       (howm-todo-priority-schedule-1 late lz item)
 575     (howm-todo-priority-schedule-2 late lz item)))
 576
 577 (defun howm-todo-priority-schedule-1 (late lz item)
 578   (let ((lazy (or lz howm-todo-priority-schedule-laziness))
 579         (from (howm-reminder-schedule-interval-from))
 580         (to   (howm-reminder-schedule-interval-to))
 581         (top  howm-todo-priority-schedule-top)
 582         (bot  howm-todo-priority-schedule-bottom))
 583     (cond ((< late (- to))        (+ bot late))
 584           ((< late (+ from lazy)) (+ top late))
 585           (t (+ bot late)))))
 586
 587 (defun howm-todo-priority-schedule-2 (late lz item)
 588   "This function may be obsolete in future.
 589 `howm-todo-priority-schedule-1' will be used instead."
 590   (let ((r (howm-todo-relative-late late lz
 591                                     howm-todo-priority-schedule-laziness)))
 592     (cond ((> r 0) (+ r howm-todo-priority-schedule-bottom))
 593           (t r))))
 594
 595 (defun howm-todo-priority-done (late lz item)
 596   (+ late howm-todo-priority-done-bottom))
 597
 598 (defun howm-todo-priority-unknown (late lz item)
 599   (+ late howm-todo-priority-unknown-top))
 600
 601 (defun howm-encode-day (&optional d m y)
 602   "Convert date Y-M-D to a float number, days from the reference date.
 603 When D is omitted, the current time is encoded.
 604 When D is t, the beginning of today is encoded."
 605   (let* ((e (apply #'encode-time (cond ((eq d t)
 606                                         (let ((now (howm-decode-time)))
 607                                           (append '(0 0 0) (cl-cdddr now))))
 608                                        (d
 609                                         (mapcar #'string-to-number
 610                                                 (list "0" "0" "0" d m y)))
 611                                        (t
 612                                         (howm-decode-time)))))
 613          (hi (car e))
 614          (low (cadr e))
 615          (daysec (* 60 60 24.0)))
 616     (+ (* hi (/ 65536 daysec)) (/ low daysec))))
 617
 618 (defun howm-congrats ()
 619   (setq howm-congrats-count (1+ howm-congrats-count))
 620   (let* ((n (length howm-congrats-format))
 621          (r (random n)))
 622     (message (nth r howm-congrats-format) howm-congrats-count)
 623     (when howm-congrats-command
 624       (howm-congrats-run howm-congrats-command))
 625     (run-hooks 'howm-congrats-hook)))
 626 (defun howm-congrats-run (com-arg-list)
 627   (let* ((name "howm-congrats")
 628          (command (car com-arg-list))
 629          (args (cdr com-arg-list))
 630          (prev (get-process name)))
 631     (when prev
 632       (delete-process prev))
 633     (apply #'start-process-shell-command `(,name nil ,command ,@args))))
 634
 635 (defun howm-action-lock-reminder-done-rule ()
 636   (list (howm-reminder-regexp howm-reminder-types)
 637         `(lambda (&optional arg)
 638            (let ((command (if arg
 639                               nil
 640                             howm-action-lock-reminder-done-default)))
 641              (howm-action-lock-done command)))
 642         howm-reminder-regexp-command-pos))
 643
 644 (defun howm-reminder-search-path ()
 645   (howm-search-path t))
 646
 647 (defun howm-reminder-search-path-folder ()
 648   (howm-search-path-folder t))
 649
 650 ;;; direct manipulation of items from todo list
 651
 652 ;; I'm sorry for dirty procedure here.
 653 ;; If we use naive howm-date-regexp, it matches to file name "2004-05-11.txt"
 654 ;; in summary mode.
 655 (defun howm-action-lock-reminder-forward-rules (&optional summary-mode-p)
 656   (let* ((action-maker (lambda (pos)
 657                          `(lambda (&optional dummy)
 658                             (howm-action-lock-forward (match-beginning ,pos)))))
 659          (reminder-rule (list (howm-reminder-regexp howm-reminder-types)
 660                               (funcall action-maker 0)
 661                               howm-reminder-regexp-command-pos))
 662          (summary-date-reg (format ".*%s.*\\(%s\\)"
 663                                    (regexp-quote howm-view-summary-sep)
 664                                    howm-date-regexp))
 665          (summary-date-reg-pos 1)
 666          (summary-date-rule (list summary-date-reg
 667                                   (funcall action-maker summary-date-reg-pos)
 668                                   summary-date-reg-pos))
 669          (menu-date-rule (list howm-date-regexp
 670                                (funcall action-maker 0)))
 671          (date-rule (if summary-mode-p
 672                         summary-date-rule
 673                       menu-date-rule)))
 674     (list reminder-rule date-rule)))
 675
 676 (defvar howm-action-lock-forward-wconf nil
 677   "for internal use")
 678 (defun howm-action-lock-forward-escape ()
 679   (setq howm-action-lock-forward-wconf
 680         (current-window-configuration)))
 681 (defmacro howm-action-lock-forward-block (&rest body)
 682   (declare (indent 0))
 683   `(prog2
 684        (setq howm-action-lock-forward-wconf nil)
 685        (progn
 686          ,@body)
 687      (when howm-action-lock-forward-wconf
 688        (set-window-configuration howm-action-lock-forward-wconf))))
 689
 690 (defun howm-action-lock-forward (form-pos)
 691   (howm-action-lock-forward-block
 692     (let* ((cursor-pos (point))
 693            (form-reg (howm-line-tail-regexp form-pos))
 694            (cursor-reg (howm-line-tail-regexp cursor-pos)))
 695       (let* ((mt (buffer-modified-tick))
 696              (original-tail (buffer-substring form-pos (line-end-position)))
 697              (modified-tail (howm-action-lock-forward-invoke form-reg
 698                                                              cursor-reg))
 699              (untouched-p (= mt (buffer-modified-tick))))
 700         ;; Current-buffer may be already updated according to
 701         ;; howm-menu-refresh-after-save because save-buffer in
 702         ;; howm-action-lock-forward-invoke can run howm-after-save-hook.
 703         ;; We have to exclude such cases.
 704         (when (and untouched-p
 705                    (not (string= original-tail modified-tail)))
 706           (let ((buffer-read-only nil))
 707             (howm-menu-list-getput-item original-tail modified-tail)
 708             (delete-region form-pos (line-end-position))
 709             (insert modified-tail)))
 710         (goto-char cursor-pos)
 711         (howm-action-lock-forward-update)))))
 712
 713 (defun howm-line-tail-regexp (pos)
 714   (concat (regexp-quote (buffer-substring-no-properties pos
 715                                                         (line-end-position)))
 716           "$"))
 717
 718 (defun howm-action-lock-forward-invoke (form-reg cursor-reg)
 719   (howm-modify-in-background (lambda (&rest dummy)
 720                                ;; open the target file
 721                                ;; and go to the corresponding line
 722                                (howm-action-lock-forward-open))
 723                              (lambda (form-reg cursor-reg)
 724                                (howm-action-lock-forward-modify-current-line
 725                                 form-reg cursor-reg))
 726                              howm-action-lock-forward-save-buffer
 727                              howm-action-lock-forward-kill-buffer
 728                              form-reg
 729                              cursor-reg))
 730
 731 (defun howm-modify-in-background (opener modifier save-p kill-p &rest args)
 732   (save-excursion
 733     (save-window-excursion
 734       (let ((original-buffers (buffer-list)))
 735         (apply opener args)
 736         ;; We are in the target buffer now.
 737         (let ((initially-modified-p (buffer-modified-p)))
 738           (prog1
 739               (apply modifier args)
 740             (when (and save-p
 741                        (not initially-modified-p)
 742                        (buffer-modified-p))
 743               (save-buffer))
 744             (when (and kill-p
 745                        (not (buffer-modified-p))
 746                        (not (member (current-buffer) original-buffers)))
 747               (kill-buffer (current-buffer)))))))))
 748
 749 (defun howm-action-lock-forward-modify-current-line (form-reg cursor-reg)
 750   (howm-modify-form #'action-lock-invoke form-reg cursor-reg))
 751
 752 (defun howm-modify-form (proc form-reg cursor-reg &rest args)
 753   (cl-labels
 754       ((f-cursor ()
 755                  (beginning-of-line)
 756                  (re-search-forward cursor-reg
 757                                     (line-end-position
 758                                      (+ 1 howm-action-lock-forward-fuzziness))
 759                                     t))
 760        (b-cursor ()
 761                  (end-of-line)
 762                  (re-search-backward cursor-reg
 763                                      (line-beginning-position
 764                                       (- 1 howm-action-lock-forward-fuzziness))
 765                                      t))
 766        (b-form ()
 767                (end-of-line)
 768                (re-search-backward form-reg (line-beginning-position) t)))
 769     (or (save-excursion (and (f-cursor) (b-form)))
 770         (save-excursion (and (b-cursor) (b-form)))
 771         (error "Can't find corresponding line.")))
 772   (goto-char (match-beginning 0))
 773   ;; Now we are at the beginning of the form.
 774   ;; Remember this position to report the modified tail.
 775   (save-excursion
 776     (when (not (re-search-forward cursor-reg (line-end-position) t))
 777       (error "Can't find corresponding string."))
 778     (goto-char (match-beginning 0))
 779     ;; update display. I don't understand why this is needed.
 780     ;; Without this, cursor is placed at the end of buffer if I delete many
 781     ;; lines before the form position in the below setting (GNU Emacs 21.4.1).
 782     ;;   (setq howm-menu-refresh-after-save nil)
 783     ;;   (setq howm-menu-expiry-hours 3)
 784     ;;   (setq howm-action-lock-forward-fuzziness 20000)
 785     ;; Sigh...
 786     (switch-to-buffer (current-buffer) t)
 787     ;; Now we are at the corresponding position.
 788     ;; Let's call proc to modify the form!
 789     (undo-boundary)
 790     (apply proc args))
 791   ;; We are back to the beginning of the form.
 792   ;; Report the modified tail.
 793   (buffer-substring-no-properties (point) (line-end-position)))
 794
 795 (defun howm-action-lock-forward-open ()
 796   (cond ((eq major-mode 'howm-menu-mode)
 797          (progn
 798            (howm-menu-list-action)
 799            (when (eq major-mode 'howm-view-summary-mode)
 800              (error "Several candidates."))))
 801         ((eq major-mode 'howm-view-summary-mode)
 802          (howm-view-summary-open))
 803         (t
 804          (error "Not supported on this buffer."))))
 805
 806 (defun howm-action-lock-forward-update ()
 807   (cond ((eq major-mode 'howm-menu-mode)
 808          nil) ; do nothing
 809         ((eq major-mode 'howm-view-summary-mode)
 810          (howm-view-summary-check t))
 811         (t
 812          (error "Not supported on this buffer."))))
 813
 814 ;;; extend deadlines (experimental)
 815
 816 (put 'howm-extend-deadlines 'disabled t)
 817 (defun howm-extend-deadlines (days)
 818   "Extend all overdue deadlines for DAYS from today."
 819   (interactive "nHow many days? ")
 820   (let ((hit (cl-remove-if (lambda (item)
 821                              (< (cadr (howm-reminder-parse item)) 0))
 822                            (howm-reminder-search "!"))))
 823     (mapc (lambda (item)
 824             (howm-modify-in-background (lambda (item dummy)
 825                                          (howm-view-open-item item))
 826                                        #'howm-extend-deadline-here
 827                                        nil nil item days))
 828           hit)
 829     (howm-menu-refresh-background)
 830     (message "Extended %s deadline(s)." (length hit))))
 831
 832 (defun howm-extend-deadline-here (item days)
 833   (apply (lambda (form-reg cursor-reg) ;; use apply for destructuring-bind
 834            (howm-modify-form #'howm-extend-deadline-doit
 835                              form-reg cursor-reg days))
 836          (let ((summary (howm-item-summary item)))
 837            (string-match (howm-reminder-regexp ".") summary)
 838            (mapcar (lambda (p)
 839                      (concat (regexp-quote
 840                               (substring summary (match-beginning p)))
 841                              "$"))
 842                    (list howm-reminder-regexp-date-pos
 843                          howm-reminder-regexp-year-pos)))))
 844
 845 (defun howm-extend-deadline-doit (days)
 846   (or (looking-at howm-date-regexp)
 847       (re-search-backward howm-date-regexp (line-beginning-position) t)
 848       (error "Can't find corresponding date form."))
 849   (howm-datestr-replace
 850    (howm-datestr-shift (howm-time-to-datestr) 0 0 days)))
 851
 852 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 853 ;; customize
 854
 855 (defun howm-define-reminder (letter priority-func face schedule todo
 856                                     &optional reminder)
 857   "Define reminder type LETTER whose priority is determined by PRIORITY-FUNC.
 858 It appears with FACE in schedule list when SCHEDULE is non-nil, and in
 859 todo list when TODO is non-nil.  It also appears in menu if SCHEDULE
 860 or TODO is t."
 861   (add-to-list 'howm-todo-priority-func
 862                (cons letter priority-func))
 863   (add-to-list 'howm-reminder-font-lock-keywords
 864                `(,(howm-reminder-regexp (format "[%s]" letter))
 865                  (0 ,face prepend)))
 866   (let* ((schedule-menu (eq schedule t))
 867          (todo-menu (eq todo t))
 868          (reminder-menu (or schedule-menu todo-menu)))
 869     ;; Don't modify howm-reminder-marks.
 870     ;; Otherwise, defcustom will be confused for howm-reminder-menu-types, etc.
 871     (cl-mapcar (lambda (var flag)
 872                        (howm-modify-reminder-types var letter flag))
 873                      '(howm-reminder-types
 874                        howm-schedule-types howm-todo-types
 875                        howm-schedule-menu-types howm-todo-menu-types
 876                        howm-reminder-menu-types)
 877                      (list t schedule todo
 878                            schedule-menu todo-menu reminder-menu))))
 879
 880 (defun howm-modify-reminder-types (var letter flag)
 881   "Modify variable VAR whose value is \"[...]\".
 882 Example:
 883  (setq foo \"[abc]\")
 884  (howm-modify-reminder-types 'foo \"d\" t)  foo ==> \"[abcd]\"
 885  (howm-modify-reminder-types 'foo \"b\" nil)  foo ==> \"[acd]\"
 886 "
 887   (let ((val (symbol-value var)))
 888     (when (not (string-match "^\\[\\(.*\\)\\]$" val))
 889       (error "Wrong format - %s: %s" var val))
 890     (let* ((old (match-string-no-properties 1 val))
 891            (removed (remove (string-to-char letter) old))
 892            (new (if flag
 893                     ;; This order is important when val is "[-+~!.]".
 894                     (concat removed letter)
 895                   removed)))
 896       (set var (format "[%s]" new)))))
 897
 898 ;; (example)
 899 ;; If you write like below in your memo, it will appear
 900 ;; under today's schedule in reminder list.
 901 ;; The date "2004-11-01" is dummy and "0" means the position "today - 0".
 902 ;;   [2004-11-01]_0 ========================
 903 ;; (defun howm-todo-priority-separator (late lazy item)
 904 ;;   (- howm-huge (or lazy 0) -1))
 905 ;; (defface howm-reminder-separator-face
 906 ;;   ;; invisible :p
 907 ;;   '((((class color) (background light)) (:foreground "white"))
 908 ;;     (((class color) (background dark)) (:foreground "black"))
 909 ;;     (t ()))
 910 ;;   "Face for `howm-list-reminder'. This is obsolete and will be removed in future."
 911 ;;   :group 'howm-faces)
 912 ;; (defvar howm-reminder-separator-face 'howm-reminder-separator-face)
 913 ;; (defvar howm-reminder-separator-type "_")
 914 ;; (howm-define-reminder howm-reminder-separator-type
 915 ;;                       #'howm-todo-priority-separator
 916 ;;                       'howm-reminder-separator-face t t)
 917
 918 ;;; howm-reminder.el ends here