OSDN Git Service

set version as 1.4.4-snapshot
[howm/howm.git] / howm-date.el
1 ;;; howm-date.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2015, 2016
3 ;;;   HIRAOKA Kazuyuki <khi@users.sourceforge.jp>
4 ;;; $Id: howm-date.el,v 1.35 2011-12-31 15:07:29 hira Exp $
5 ;;;
6 ;;; This program is free software; you can redistribute it and/or modify
7 ;;; it under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 1, or (at your option)
9 ;;; any later version.
10 ;;;
11 ;;; This program is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 ;;; GNU General Public License for more details.
15 ;;;
16 ;;; The GNU General Public License is available by anonymouse ftp from
17 ;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
18 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
19 ;;; USA.
20 ;;--------------------------------------------------------------------
21
22 (provide 'howm-date)
23 (require 'howm)
24
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 ;; insert & action-lock
27
28 (defvar howm-insert-date-pass-through nil)
29
30 (defun howm-insert-date ()
31   (interactive)
32   (let ((date (format-time-string howm-date-format)))
33     (insert (format howm-insert-date-format date))
34     (howm-action-lock-date date t howm-insert-date-future)))
35
36 (defun howm-insert-dtime ()
37   (interactive)
38   (insert (format-time-string howm-dtime-format)))
39
40 ;; Sorry for ugly behavior around "new" to keep backward compatibility.
41 (defun howm-action-lock-date (date &optional new future-p)
42   (let* ((pass-through (and new howm-insert-date-pass-through))
43          (prompt (howm-action-lock-date-prompt date new pass-through))
44          (immediate-chars (if pass-through "" "."))
45          (c (howm-read-string prompt immediate-chars "+-~0123456789"
46                               pass-through pass-through)))
47     (cond
48      ((null c) nil) ;; pass through
49      ((string= c "")
50       (if new
51           t
52         (howm-action-lock-date-search date)))
53      ((string-match "^[-+][0-9]+$" c)
54       (howm-action-lock-date-shift (string-to-number c) date))
55      ((string-match "^[0-9]+$" c)
56       (howm-action-lock-date-set c date future-p))
57      ((string-match "^~\\([0-9]+\\)$" c)
58       (howm-action-lock-date-repeat (match-string-no-properties 1 c) date))
59      ((string-match "^[.]$" c)
60       (howm-datestr-replace (howm-time-to-datestr)))
61      ((and (string-match "^[-+~]$" c) pass-through)
62       (insert c))
63      (t (error (format "Can't understand %s." c))))))
64
65 (defun howm-action-lock-date-prompt (date new pass-through)
66   (let* ((dow (howm-datestr-day-of-week date))
67          (common-help "+num(shift), yymmdd(set), ~yymmdd(repeat)")
68          (today-help ", .(today)")
69          (help (cond ((and new pass-through)
70                       common-help)
71                      ((and new (not pass-through))
72                       (concat "RET(ok), " common-help today-help))
73                      ((not new)
74                       (concat "RET(list), " common-help today-help))
75                      (t
76                       (error "Can't happen.")))))
77     (format "[%s] %s: " dow help)))
78
79 (defvar howm-date-current nil)
80 (make-variable-buffer-local 'howm-date-current)
81
82 (defun howm-action-lock-date-search (date)
83   (howm-set-command 'howm-action-lock-date-search)
84   (prog1
85       (howm-search date t)
86     (howm-action-lock-forward-escape)
87     (setq howm-date-current date)))
88
89 (defun howm-search-today ()
90   (interactive)
91   (howm-search-past 0))
92
93 (defun howm-search-past (&optional days-before)
94   (interactive "P")
95   (let* ((n (or days-before 0))
96          (today (format-time-string howm-date-format))
97          (target (howm-datestr-shift today 0 0 (- n))))
98     (howm-action-lock-date-search target)))
99
100 (defun howm-action-lock-date-shift (n date)
101   (howm-datestr-replace (howm-datestr-shift date 0 0 n)))
102
103 (defun howm-action-lock-date-set (val date &optional future-p)
104   (howm-datestr-replace (howm-datestr-expand val date future-p)))
105
106 (defvar howm-action-lock-date-repeat-max 200)
107 (defun howm-action-lock-date-repeat (until date)
108   (let ((every (read-from-minibuffer "Every? [RET(all), num(days), w(week), m(month), y(year)] ")))
109     (let ((max-d (howm-datestr-expand until date t))
110           (offset-y (if (string= every "y") 1 0))
111           (offset-m (if (string= every "m") 1 0))
112           (offset-d (or (cdr (assoc every '(("y" . 0) ("m" . 0) ("w" . 7))))
113                         (max (string-to-number every) 1))))
114       (let ((d date)
115             (i 0)
116             (check t))
117         (catch 'too-many
118           (while (progn
119                    (setq d (howm-datestr-shift d offset-y offset-m offset-d))
120                    (howm-datestr<= d max-d))
121             (when (and check (>= i howm-action-lock-date-repeat-max))
122               (if (y-or-n-p (format "More than %d lines. Continue? " i))
123                   (setq check nil)
124                 (throw 'too-many nil)))
125             (howm-duplicate-line)
126             (howm-datestr-replace d)
127             (setq i (+ i 1))))))))
128
129 (defun howm-make-datestr (y m d)
130   (let ((ti (encode-time 0 0 0 d m y)))
131     (format-time-string howm-date-format ti)))
132
133 (defun howm-datestr-parse (date)
134   (string-match howm-date-regexp date)
135   (mapcar (lambda (pos)
136             (string-to-number (match-string-no-properties pos date)))
137           (list howm-date-regexp-year-pos
138                 howm-date-regexp-month-pos
139                 howm-date-regexp-day-pos)))
140
141 (defun howm-datestr-to-time (date)
142   (let* ((ymd (howm-datestr-parse date))
143          (y (car ymd))
144          (m (cadr ymd))
145          (d (cl-caddr ymd)))
146     (encode-time 0 0 0 d m y)))
147
148 (defun howm-time-to-datestr (&optional time)
149   (let ((x (decode-time time)))
150     (howm-make-datestr (nth 5 x) (nth 4 x) (nth 3 x))))
151
152 (defun howm-datestr-day-of-week (date)
153   (format-time-string "%a" (howm-datestr-to-time date)))
154
155 (defun howm-datestr-expand (date base &optional future-p)
156   (if future-p
157       (howm-datestr-expand-future date base)
158     (howm-datestr-expand-general date base future-p)))
159
160 (defun howm-datestr-expand-future (date base)
161   (let ((raw (howm-datestr-expand-general date base nil))
162         (future (howm-datestr-expand-general date base t)))
163     (when (not (string= raw future))
164       (message "Future date"))
165     future))
166
167 (defun howm-datestr-expand-general (date base &optional future-p)
168   (let* ((base-ymd (howm-datestr-parse base))
169          (nval (format "%8s" date))
170          (given-ymd-str (mapcar (lambda (r)
171                                   (substring nval (car r) (cadr r)))
172                                 '((0 4) (4 6) (6 8))))
173          (ys (car given-ymd-str))
174          (ms (cadr given-ymd-str))
175          (ds (cl-caddr given-ymd-str)))
176      (when (string-match "^ +0+$" ys)
177        (setq ys "2000"))
178      (let* ((given-ymd (mapcar #'string-to-number (list ys ms ds)))
179             (carry nil) ;; to force future date
180             (dmy (cl-mapcar (lambda (ox nx)
181                                     (when future-p
182                                       (when (and carry (= nx 0))
183                                         (setq ox (+ ox 1)))
184                                       (setq carry
185                                             (cond ((= nx 0) nil)
186                                                   ((= nx ox) carry)
187                                                   ((< nx ox) t)
188                                                   (t nil))))
189                                     (if (= nx 0) ox nx))
190                                   (reverse base-ymd) (reverse given-ymd)))
191          (d (car dmy))
192          (m (cadr dmy))
193          (y (cl-caddr dmy)))
194        (howm-make-datestr (if (<= y 99) (+ y 2000) y) m d))))
195
196 (defun howm-datestr-shift (date y m d)
197   (let* ((ymd (howm-datestr-parse date))
198          (oy (car ymd))
199          (om (cadr ymd))
200          (od (cl-caddr ymd)))
201     (howm-make-datestr (+ oy y) (+ om m) (+ od d))))
202
203 (defun howm-datestr<= (date1 date2)
204   (or (string< date1 date2)
205       (string= date1 date2)))
206
207 (defun howm-datestr-replace (date)
208   (let ((p (point)))
209     (while (not (looking-at howm-date-regexp))
210       (backward-char))
211     (replace-match date t t)
212     (goto-char p)))
213
214 (defun howm-duplicate-line ()
215   (let ((c (current-column))
216         (s (buffer-substring (line-beginning-position) (line-end-position))))
217     (end-of-line)
218     (insert "\n" s)
219     (move-to-column c)))
220
221 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
222 ;; search for next/previous date
223
224 (defvar howm-date-forward-ymd-msg "Searching %s...")
225 (defvar howm-date-forward-ymd-limit 35)
226 (defun howm-date-forward-ymd (y m d)
227   (when (not howm-date-current)
228     (error "Not in date search."))
229   (let* ((new-date (howm-datestr-shift howm-date-current y m d))
230          (b (current-buffer))
231          (step (if (> (+ y m d) 0) +1 -1))
232          (c 0))
233     (when (catch :found
234             (while (progn
235                    (when (howm-action-lock-date-search new-date)
236                      (throw :found t))
237                    (< c howm-date-forward-ymd-limit))
238             (setq new-date (howm-datestr-shift new-date 0 0 step))
239             (setq c (1+ c))
240             (when howm-date-forward-ymd-msg
241               (format howm-date-forward-ymd-msg new-date)))
242           (error "Not found within %d days." howm-date-forward-ymd-limit))
243       (when (not (eq (current-buffer) b))
244         (with-current-buffer b
245           (howm-view-kill-buffer)))
246       (howm-view-summary-check t))))
247
248 (defmacro howm-date-defun-f/b (func y m d)
249   `(defun ,func (&optional k)
250      (interactive "P")
251      (let ((n (or k 1)))
252        (howm-date-forward-ymd ,y ,m ,d))))
253
254 (howm-date-defun-f/b howm-date-forward       0 0 n)
255 (howm-date-defun-f/b howm-date-forward-month 0 n 0)
256 (howm-date-defun-f/b howm-date-forward-year  n 0 0)
257 (howm-date-defun-f/b howm-date-backward       0 0 (- n))
258 (howm-date-defun-f/b howm-date-backward-month 0 (- n) 0)
259 (howm-date-defun-f/b howm-date-backward-year  (- n) 0 0)
260
261 (let ((m howm-view-summary-mode-map))
262   (define-key m "+" 'howm-date-forward)
263   (define-key m "-" 'howm-date-backward)
264   (define-key m ")" 'howm-date-forward)
265   (define-key m "(" 'howm-date-backward)
266   (define-key m "}" 'howm-date-forward-month)
267   (define-key m "{" 'howm-date-backward-month)
268   (define-key m "]" 'howm-date-forward-year)
269   (define-key m "[" 'howm-date-backward-year)
270   )
271
272 ;;; howm-date.el ends here