OSDN Git Service

delete obsolete CVS keywords "$Id"
[howm/howm.git] / howm-reminder.el
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 ;;;
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)
8 ;;; any later version.
9 ;;;
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.
14 ;;;
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,
18 ;;; USA.
19 ;;--------------------------------------------------------------------
20
21 (provide 'howm-reminder)
22 (require 'howm)
23
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'.")
28
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+)
57
58 (defvar howm-action-lock-reminder-done-default nil)
59
60 (defvar howm-congrats-count 0)
61
62 ;;; --- level ? ---
63
64 ;; Fix me: redundant (howm-date-* & howm-reminder-*)
65
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))
70
71 (if howm-reminder-old-format
72     (progn ;; 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
89         `(
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))
98           ))
99       (defun howm-reminder-font-lock-keywords ()
100         howm-reminder-font-lock-keywords)
101       (defun howm-action-lock-done (&optional command)
102         (save-excursion
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")
114                             (t nil))))
115               (when (string= s "")
116                 (howm-congrats))
117               (if c
118                   (progn
119                     (goto-char at-beg)
120                     (delete-region at-beg at-end)
121                     (insert (howm-reminder-today))
122                     (insert (format "%s " c)))
123                 (progn
124                   (goto-char lazy-beg)
125                   (delete-region lazy-beg lazy-end)
126                   (when (string= (buffer-substring-no-properties type-beg type-end)
127                                  " ")
128                     (goto-char type-beg)
129                     (insert "-")) ;; "no type" = "normal"
130                   (insert s)))))))
131       )
132   (progn ;; new format
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
155       `(
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))
164         ))
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)
171       ;; parse line
172       (let* ((pos (point))
173              (beg (match-beginning 0))
174              (end (match-end 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)
182                                         "x-+~!.@"
183                                         "0123456789")))
184                (type-or-lazy (string-match (format "^\\(%s?\\)\\([0-9]*\\)$"
185                                                    howm-reminder-types)
186                                            s))
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))
196                            ((string= s "x")
197                             (howm-action-lock-done-cancel date type lazy
198                                                           desc))
199                            (type-or-lazy
200                             (howm-action-lock-done-modify date
201                                                           new-type new-lazy
202                                                           desc))
203                            (t
204                             (error "Can't understand %s" s)))))
205             ;; replace contents
206             (goto-char beg)
207             (delete-region (point) (line-end-position))
208             (insert new)
209             (goto-char pos)))))
210     (defun howm-action-lock-done-done (date type lazy desc &optional done-mark)
211       (when (null done-mark)
212         (setq done-mark ".")
213         (howm-congrats))
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))
221     ))
222
223 (defun howm-reminder-deadline-type-face ()
224   (let ((late (cadr (howm-todo-parse-string (match-string-no-properties 0)))))
225     (if (>= late 0)
226         howm-reminder-late-deadline-face
227       howm-reminder-deadline-face)))
228
229 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
230 ;; Reminder: schedule & todo
231
232 (define-key howm-view-summary-mode-map "." 'howm-reminder-goto-today)
233
234 ;; Clean me.
235 ;; I cannot remember why I wrote howm-with-schedule-summary-format.
236 (defmacro howm-with-schedule-summary-format (&rest body)
237   (declare (indent 0))
238   `(let ((howm-view-summary-format (if howm-view-split-horizontally ;; dirty!
239                                       ""
240                                     howm-view-summary-format)))
241      ,@body))
242
243 (defun howm-list-schedule ()
244   (interactive)
245   (howm-with-need
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))))
252
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))))
259
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)))
267
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)
274                     string)
275     :group 'howm-faces))
276
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)))))
282
283 (defun howm-reminder-add-font-lock ()
284   (cheat-font-lock-append-keywords (howm-reminder-add-font-lock-internal)))
285
286 (defun howm-reminder-add-font-lock-internal ()
287   (append (howm-reminder-font-lock-keywords)
288           (howm-reminder-today-font-lock-keywords)))
289
290 (defun howm-reminder-omit-before (regexp str)
291   (string-match regexp str)
292   (substring str (match-beginning 0)))
293
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))
304           's))))
305
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))))
309
310 ;; dirty. peek howm-view-*
311 (defun howm-reminder-goto-today ()
312   (interactive)
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)
321           (n 0))
322       (while (and rest
323                   (string< (car rest) today))
324         (setq rest (cdr rest)
325               n (1+ n)))
326       (howm-goto-line (1+ n)))))
327
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)))
336                                             (or (< s from)
337                                                 (< to s))))
338                                       raw)))
339     (howm-schedule-sort-items filtered)))
340
341 (defun howm-schedule-sort-items (items &optional reverse-p)
342   (when reverse-p
343     (error "Not supported."))
344   (howm-with-schedule-summary-format
345     (howm-sort #'howm-schedule-sort-converter #'howm-schedule-sort-comparer
346                items)))
347 (defun howm-schedule-sort-by-date ()
348   (interactive)
349   (howm-view-sort-doit #'howm-schedule-sort-items))
350 (defun howm-schedule-sort-converter (item)
351   (let ((z (howm-reminder-parse item)))
352     (cons (car z)
353           (if howm-schedule-sort-by-time
354               (howm-item-summary item)
355             (nth 5 z)))))
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))))
360
361 (defun howm-schedule-date (item)
362   (car (howm-reminder-parse item)))
363
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)))
370
371 (defun howm-list-todo ()
372   (interactive)
373   (howm-list-todo-sub))
374
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 ()
380   (interactive)
381   (howm-list-todo-sub (lambda (item)
382                         (not (howm-todo-sleeping-p item)))))
383 (defun howm-list-sleeping-todo ()
384   (interactive)
385   (howm-list-todo-sub #'howm-todo-sleeping-p))
386
387 (defun howm-list-todo-sub (&optional pred)
388   (howm-with-need
389     (howm-with-schedule-summary-format
390       (let ((items (need (howm-list-reminder-internal howm-todo-types))))
391         (when pred
392           (setq items
393                 (need (cl-remove-if-not pred items))))
394         (setq items (howm-todo-sort-items items))
395         (when howm-todo-separators
396           (setq items
397                 (howm-todo-insert-separators items
398                                              howm-todo-separators)))
399       (howm-list-reminder-final-setup howm-list-todo-name items)))))
400
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)
410                                          limit-priority))
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)
414                                  separators t)))
415
416 (defun howm-reminder-menu (n limit-priority separators)
417   (howm-with-reminder-setting
418     (howm-todo-menu n limit-priority separators)))
419
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))
423                     item-list))
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))))
430                      separators)))
431     (mapcar #'cdr
432             (sort (append is sep) #'(lambda (x y) (> (car x) (car y)))))))
433
434 (defun howm-todo-sort-items (items &optional reverse-p)
435   (when reverse-p
436     (error "Not supported."))
437   (howm-sort #'howm-todo-priority-ext #'howm-todo-priority-ext-gt
438              items))
439
440 (defun howm-todo-sort-by-priority ()
441   (howm-view-sort-doit #'howm-todo-sort-items))
442
443 ;; Clean me.
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\")"
452   (let ((summary str))
453     (string-match (howm-reminder-regexp ".") summary)
454     (let ((y (match-string-no-properties howm-reminder-regexp-year-pos
455                                          summary))
456           (m (match-string-no-properties howm-reminder-regexp-month-pos
457                                          summary))
458           (d (match-string-no-properties howm-reminder-regexp-day-pos
459                                          summary))
460           (ty (match-string-no-properties howm-reminder-regexp-type-pos
461                                           summary))
462           (lz (match-string-no-properties howm-reminder-regexp-laziness-pos
463                                           summary))
464           (description (substring str (match-end 0))))
465       (let* ((day (howm-encode-day d m y))
466              (today (howm-encode-day))
467              (late (- today day))
468              (type (substring (or ty "-") 0 1)) ;; "-" for old format
469              (lazy (cond ((string= type " ") nil)
470                          ((null lz) nil)
471                          (t (let ((z (string-to-number lz)))
472                               (if (= z 0) nil z)))))
473              ;;            (lazy (if (string= type " ")
474              ;;                      0
475              ;;                    (string-to-number (or lz "0"))))
476              (day-of-week (nth 6
477                                (decode-time (apply #'encode-time
478                                                    (mapcar #'string-to-number
479                                                            (list "0" "0" "0"
480                                                                  d m y)))))))
481         (list day late type lazy day-of-week description)))))
482
483 (defun howm-todo-priority (item)
484   (let* ((p (howm-todo-parse item))
485          (late (car p))
486          (type (cadr p))
487          (lazy (cl-caddr p))
488          (f (or (cdr (assoc type howm-todo-priority-func))
489                 #'howm-todo-priority-unknown)))
490     (funcall f late lazy item)))
491
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)))))
500
501 (defun howm-todo-relative-late (late laziness default-laziness)
502   (/ late (float (or laziness default-laziness))))
503
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))
508           (t (- r)))))
509
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))
515           (t (* c (- r 1))))))
516
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)))))))
525
526 ;; ;; Clean me.
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))
532 ;;     ,@body))
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))
540 ;;         (t
541 ;;          (+ late howm-todo-priority-schedule-bottom))))
542
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)))
547
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))
558           ((< r -1) (+ bot r))
559           (t (* c r)))))
560
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))
569           (t (* c r)))))
570
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)))
575
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))
584           (t (+ bot late)))))
585
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))
592           (t r))))
593
594 (defun howm-todo-priority-done (late lz item)
595   (+ late howm-todo-priority-done-bottom))
596
597 (defun howm-todo-priority-unknown (late lz item)
598   (+ late howm-todo-priority-unknown-top))
599
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))))
607                                        (d
608                                         (mapcar #'string-to-number
609                                                 (list "0" "0" "0" d m y)))
610                                        (t
611                                         (howm-decode-time)))))
612          (hi (car e))
613          (low (cadr e))
614          (daysec (* 60 60 24.0)))
615     (+ (* hi (/ 65536 daysec)) (/ low daysec))))
616
617 (defun howm-congrats ()
618   (setq howm-congrats-count (1+ howm-congrats-count))
619   (let* ((n (length howm-congrats-format))
620          (r (random n)))
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)))
630     (when prev
631       (delete-process prev))
632     (apply #'start-process-shell-command `(,name nil ,command ,@args))))
633
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
638                               nil
639                             howm-action-lock-reminder-done-default)))
640              (howm-action-lock-done command)))
641         howm-reminder-regexp-command-pos))
642
643 (defun howm-reminder-search-path ()
644   (howm-search-path t))
645
646 (defun howm-reminder-search-path-folder ()
647   (howm-search-path-folder t))
648
649 ;;; direct manipulation of items from todo list
650
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"
653 ;; in summary mode.
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)
663                                    howm-date-regexp))
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
671                         summary-date-rule
672                       menu-date-rule)))
673     (list reminder-rule date-rule)))
674
675 (defvar howm-action-lock-forward-wconf nil
676   "for internal use")
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)
681   (declare (indent 0))
682   `(prog2
683        (setq howm-action-lock-forward-wconf nil)
684        (progn
685          ,@body)
686      (when howm-action-lock-forward-wconf
687        (set-window-configuration howm-action-lock-forward-wconf))))
688
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
697                                                              cursor-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)))))
711
712 (defun howm-line-tail-regexp (pos)
713   (concat (regexp-quote (buffer-substring-no-properties pos
714                                                         (line-end-position)))
715           "$"))
716
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
727                              form-reg
728                              cursor-reg))
729
730 (defun howm-modify-in-background (opener modifier save-p kill-p &rest args)
731   (save-excursion
732     (save-window-excursion
733       (let ((original-buffers (buffer-list)))
734         (apply opener args)
735         ;; We are in the target buffer now.
736         (let ((initially-modified-p (buffer-modified-p)))
737           (prog1
738               (apply modifier args)
739             (when (and save-p
740                        (not initially-modified-p)
741                        (buffer-modified-p))
742               (save-buffer))
743             (when (and kill-p
744                        (not (buffer-modified-p))
745                        (not (member (current-buffer) original-buffers)))
746               (kill-buffer (current-buffer)))))))))
747
748 (defun howm-action-lock-forward-modify-current-line (form-reg cursor-reg)
749   (howm-modify-form #'action-lock-invoke form-reg cursor-reg))
750
751 (defun howm-modify-form (proc form-reg cursor-reg &rest args)
752   (cl-labels
753       ((f-cursor ()
754                  (beginning-of-line)
755                  (re-search-forward cursor-reg
756                                     (line-end-position
757                                      (+ 1 howm-action-lock-forward-fuzziness))
758                                     t))
759        (b-cursor ()
760                  (end-of-line)
761                  (re-search-backward cursor-reg
762                                      (line-beginning-position
763                                       (- 1 howm-action-lock-forward-fuzziness))
764                                      t))
765        (b-form ()
766                (end-of-line)
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.
774   (save-excursion
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)
784     ;; Sigh...
785     (switch-to-buffer (current-buffer) t)
786     ;; Now we are at the corresponding position.
787     ;; Let's call proc to modify the form!
788     (undo-boundary)
789     (apply proc args))
790   ;; We are back to the beginning of the form.
791   ;; Report the modified tail.
792   (buffer-substring-no-properties (point) (line-end-position)))
793
794 (defun howm-action-lock-forward-open ()
795   (cond ((eq major-mode 'howm-menu-mode)
796          (progn
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))
802         (t
803          (error "Not supported on this buffer."))))
804
805 (defun howm-action-lock-forward-update ()
806   (cond ((eq major-mode 'howm-menu-mode)
807          nil) ; do nothing
808         ((eq major-mode 'howm-view-summary-mode)
809          (howm-view-summary-check t))
810         (t
811          (error "Not supported on this buffer."))))
812
813 ;;; extend deadlines (experimental)
814
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 "!"))))
822     (mapc (lambda (item)
823             (howm-modify-in-background (lambda (item dummy)
824                                          (howm-view-open-item item))
825                                        #'howm-extend-deadline-here
826                                        nil nil item days))
827           hit)
828     (howm-menu-refresh-background)
829     (message "Extended %s deadline(s)." (length hit))))
830
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)
837            (mapcar (lambda (p)
838                      (concat (regexp-quote
839                               (substring summary (match-beginning p)))
840                              "$"))
841                    (list howm-reminder-regexp-date-pos
842                          howm-reminder-regexp-year-pos)))))
843
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)))
850
851 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
852 ;; customize
853
854 (defun howm-define-reminder (letter priority-func face schedule todo
855                                     &optional reminder)
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
859 or TODO is t."
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))
864                  (0 ,face prepend)))
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))))
878
879 (defun howm-modify-reminder-types (var letter flag)
880   "Modify variable VAR whose value is \"[...]\".
881 Example:
882  (setq foo \"[abc]\")
883  (howm-modify-reminder-types 'foo \"d\" t)  foo ==> \"[abcd]\"
884  (howm-modify-reminder-types 'foo \"b\" nil)  foo ==> \"[acd]\"
885 "
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))
891            (new (if flag
892                     ;; This order is important when val is "[-+~!.]".
893                     (concat removed letter)
894                   removed)))
895       (set var (format "[%s]" new)))))
896
897 ;; (example)
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
905 ;;   ;; invisible :p
906 ;;   '((((class color) (background light)) (:foreground "white"))
907 ;;     (((class color) (background dark)) (:foreground "black"))
908 ;;     (t ()))
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)
916
917 ;;; howm-reminder.el ends here