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