1 ;;; howm-reminder.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2002, 2003, 2004, 2005-2018
3 ;;; HIRAOKA Kazuyuki <khi@users.osdn.me>
4 ;;; $Id: howm-reminder.el,v 1.83 2012-12-29 08:57:18 hira Exp $
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)
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.
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,
20 ;;--------------------------------------------------------------------
22 (provide 'howm-reminder)
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'.")
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+)
59 (defvar howm-action-lock-reminder-done-default nil)
61 (defvar howm-congrats-count 0)
65 ;; Fix me: redundant (howm-date-* & howm-reminder-*)
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))
72 (if howm-reminder-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
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))
100 (defun howm-reminder-font-lock-keywords ()
101 howm-reminder-font-lock-keywords)
102 (defun howm-action-lock-done (&optional command)
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")
121 (delete-region at-beg at-end)
122 (insert (howm-reminder-today))
123 (insert (format "%s " c)))
126 (delete-region lazy-beg lazy-end)
127 (when (string= (buffer-substring-no-properties type-beg type-end)
130 (insert "-")) ;; "no type" = "normal"
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
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))
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)
174 (beg (match-beginning 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)
185 (type-or-lazy (string-match (format "^\\(%s?\\)\\([0-9]*\\)$"
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))
198 (howm-action-lock-done-cancel date type lazy
201 (howm-action-lock-done-modify date
205 (error "Can't understand %s" s)))))
208 (delete-region (point) (line-end-position))
211 (defun howm-action-lock-done-done (date type lazy desc &optional done-mark)
212 (when (null done-mark)
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))
224 (defun howm-reminder-deadline-type-face ()
225 (let ((late (cadr (howm-todo-parse-string (match-string-no-properties 0)))))
227 howm-reminder-late-deadline-face
228 howm-reminder-deadline-face)))
230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
231 ;; Reminder: schedule & todo
233 (define-key howm-view-summary-mode-map "." 'howm-reminder-goto-today)
236 ;; I cannot remember why I wrote howm-with-schedule-summary-format.
237 (defmacro howm-with-schedule-summary-format (&rest body)
239 `(let ((howm-view-summary-format (if howm-view-split-horizontally ;; dirty!
241 howm-view-summary-format)))
244 (defun howm-list-schedule ()
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))))
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))))
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)))
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)
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)))))
284 (defun howm-reminder-add-font-lock ()
285 (cheat-font-lock-append-keywords (howm-reminder-add-font-lock-internal)))
287 (defun howm-reminder-add-font-lock-internal ()
288 (append (howm-reminder-font-lock-keywords)
289 (howm-reminder-today-font-lock-keywords)))
291 (defun howm-reminder-omit-before (regexp str)
292 (string-match regexp str)
293 (substring str (match-beginning 0)))
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))
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))))
311 ;; dirty. peek howm-view-*
312 (defun howm-reminder-goto-today ()
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)
324 (string< (car rest) today))
325 (setq rest (cdr rest)
327 (howm-goto-line (1+ n)))))
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)))
340 (howm-schedule-sort-items filtered)))
342 (defun howm-schedule-sort-items (items &optional reverse-p)
344 (error "Not supported."))
345 (howm-with-schedule-summary-format
346 (howm-sort #'howm-schedule-sort-converter #'howm-schedule-sort-comparer
348 (defun howm-schedule-sort-by-date ()
350 (howm-view-sort-doit #'howm-schedule-sort-items))
351 (defun howm-schedule-sort-converter (item)
352 (let ((z (howm-reminder-parse item)))
354 (if howm-schedule-sort-by-time
355 (howm-item-summary item)
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))))
362 (defun howm-schedule-date (item)
363 (car (howm-reminder-parse item)))
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)))
372 (defun howm-list-todo ()
374 (howm-list-todo-sub))
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 ()
382 (howm-list-todo-sub (lambda (item)
383 (not (howm-todo-sleeping-p item)))))
384 (defun howm-list-sleeping-todo ()
386 (howm-list-todo-sub #'howm-todo-sleeping-p))
388 (defun howm-list-todo-sub (&optional pred)
390 (howm-with-schedule-summary-format
391 (let ((items (need (howm-list-reminder-internal howm-todo-types))))
394 (need (cl-remove-if-not pred items))))
395 (setq items (howm-todo-sort-items items))
396 (when howm-todo-separators
398 (howm-todo-insert-separators items
399 howm-todo-separators)))
400 (howm-list-reminder-final-setup howm-list-todo-name items)))))
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)
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)
417 (defun howm-reminder-menu (n limit-priority separators)
418 (howm-with-reminder-setting
419 (howm-todo-menu n limit-priority separators)))
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))
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))))
433 (sort (append is sep) #'(lambda (x y) (> (car x) (car y)))))))
435 (defun howm-todo-sort-items (items &optional reverse-p)
437 (error "Not supported."))
438 (howm-sort #'howm-todo-priority-ext #'howm-todo-priority-ext-gt
441 (defun howm-todo-sort-by-priority ()
442 (howm-view-sort-doit #'howm-todo-sort-items))
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\")"
454 (string-match (howm-reminder-regexp ".") summary)
455 (let ((y (match-string-no-properties howm-reminder-regexp-year-pos
457 (m (match-string-no-properties howm-reminder-regexp-month-pos
459 (d (match-string-no-properties howm-reminder-regexp-day-pos
461 (ty (match-string-no-properties howm-reminder-regexp-type-pos
463 (lz (match-string-no-properties howm-reminder-regexp-laziness-pos
465 (description (substring str (match-end 0))))
466 (let* ((day (howm-encode-day d m y))
467 (today (howm-encode-day))
469 (type (substring (or ty "-") 0 1)) ;; "-" for old format
470 (lazy (cond ((string= type " ") nil)
472 (t (let ((z (string-to-number lz)))
473 (if (= z 0) nil z)))))
474 ;; (lazy (if (string= type " ")
476 ;; (string-to-number (or lz "0"))))
478 (decode-time (apply #'encode-time
479 (mapcar #'string-to-number
482 (list day late type lazy day-of-week description)))))
484 (defun howm-todo-priority (item)
485 (let* ((p (howm-todo-parse item))
489 (f (or (cdr (assoc type howm-todo-priority-func))
490 #'howm-todo-priority-unknown)))
491 (funcall f late lazy item)))
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)))))
502 (defun howm-todo-relative-late (late laziness default-laziness)
503 (/ late (float (or laziness default-laziness))))
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))
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))
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)))))))
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))
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))
542 ;; (+ late howm-todo-priority-schedule-bottom))))
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)))
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))
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))
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)))
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))
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))
595 (defun howm-todo-priority-done (late lz item)
596 (+ late howm-todo-priority-done-bottom))
598 (defun howm-todo-priority-unknown (late lz item)
599 (+ late howm-todo-priority-unknown-top))
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))))
609 (mapcar #'string-to-number
610 (list "0" "0" "0" d m y)))
612 (howm-decode-time)))))
615 (daysec (* 60 60 24.0)))
616 (+ (* hi (/ 65536 daysec)) (/ low daysec))))
618 (defun howm-congrats ()
619 (setq howm-congrats-count (1+ howm-congrats-count))
620 (let* ((n (length howm-congrats-format))
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)))
632 (delete-process prev))
633 (apply #'start-process-shell-command `(,name nil ,command ,@args))))
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
640 howm-action-lock-reminder-done-default)))
641 (howm-action-lock-done command)))
642 howm-reminder-regexp-command-pos))
644 (defun howm-reminder-search-path ()
645 (howm-search-path t))
647 (defun howm-reminder-search-path-folder ()
648 (howm-search-path-folder t))
650 ;;; direct manipulation of items from todo list
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"
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)
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
674 (list reminder-rule date-rule)))
676 (defvar howm-action-lock-forward-wconf nil
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)
684 (setq howm-action-lock-forward-wconf nil)
687 (when howm-action-lock-forward-wconf
688 (set-window-configuration howm-action-lock-forward-wconf))))
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
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)))))
713 (defun howm-line-tail-regexp (pos)
714 (concat (regexp-quote (buffer-substring-no-properties pos
715 (line-end-position)))
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
731 (defun howm-modify-in-background (opener modifier save-p kill-p &rest args)
733 (save-window-excursion
734 (let ((original-buffers (buffer-list)))
736 ;; We are in the target buffer now.
737 (let ((initially-modified-p (buffer-modified-p)))
739 (apply modifier args)
741 (not initially-modified-p)
745 (not (buffer-modified-p))
746 (not (member (current-buffer) original-buffers)))
747 (kill-buffer (current-buffer)))))))))
749 (defun howm-action-lock-forward-modify-current-line (form-reg cursor-reg)
750 (howm-modify-form #'action-lock-invoke form-reg cursor-reg))
752 (defun howm-modify-form (proc form-reg cursor-reg &rest args)
756 (re-search-forward cursor-reg
758 (+ 1 howm-action-lock-forward-fuzziness))
762 (re-search-backward cursor-reg
763 (line-beginning-position
764 (- 1 howm-action-lock-forward-fuzziness))
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.
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)
786 (switch-to-buffer (current-buffer) t)
787 ;; Now we are at the corresponding position.
788 ;; Let's call proc to modify the form!
791 ;; We are back to the beginning of the form.
792 ;; Report the modified tail.
793 (buffer-substring-no-properties (point) (line-end-position)))
795 (defun howm-action-lock-forward-open ()
796 (cond ((eq major-mode 'howm-menu-mode)
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))
804 (error "Not supported on this buffer."))))
806 (defun howm-action-lock-forward-update ()
807 (cond ((eq major-mode 'howm-menu-mode)
809 ((eq major-mode 'howm-view-summary-mode)
810 (howm-view-summary-check t))
812 (error "Not supported on this buffer."))))
814 ;;; extend deadlines (experimental)
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 "!"))))
824 (howm-modify-in-background (lambda (item dummy)
825 (howm-view-open-item item))
826 #'howm-extend-deadline-here
829 (howm-menu-refresh-background)
830 (message "Extended %s deadline(s)." (length hit))))
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)
839 (concat (regexp-quote
840 (substring summary (match-beginning p)))
842 (list howm-reminder-regexp-date-pos
843 howm-reminder-regexp-year-pos)))))
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)))
852 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
855 (defun howm-define-reminder (letter priority-func face schedule todo
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
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))
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))))
880 (defun howm-modify-reminder-types (var letter flag)
881 "Modify variable VAR whose value is \"[...]\".
884 (howm-modify-reminder-types 'foo \"d\" t) foo ==> \"[abcd]\"
885 (howm-modify-reminder-types 'foo \"b\" nil) foo ==> \"[acd]\"
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))
893 ;; This order is important when val is "[-+~!.]".
894 (concat removed letter)
896 (set var (format "[%s]" new)))))
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
907 ;; '((((class color) (background light)) (:foreground "white"))
908 ;; (((class color) (background dark)) (:foreground "black"))
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)
918 ;;; howm-reminder.el ends here