1 ;;; howm-date.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2002, 2003, 2004, 2005-2019
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 ;;--------------------------------------------------------------------
24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25 ;; insert & action-lock
27 (defvar howm-insert-date-pass-through nil)
28 (defvar howm-action-lock-date-future nil)
30 (defun howm-insert-date ()
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)))
36 (defun howm-insert-dtime ()
38 (insert (format-time-string howm-dtime-format)))
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)))
48 ((null c) nil) ;; pass through
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
57 (or future-p howm-action-lock-date-future)))
58 ((string-match "^~\\([0-9]+\\)$" c)
59 (howm-action-lock-date-repeat (match-string-no-properties 1 c) date))
60 ((string-match "^[.]$" c)
61 (howm-datestr-replace (howm-time-to-datestr)))
62 ((and (string-match "^[-+~]$" c) pass-through)
64 (t (error (format "Can't understand %s." c))))))
66 (defun howm-action-lock-date-prompt (date new pass-through)
67 (let* ((dow (howm-datestr-day-of-week date))
68 (common-help "+num(shift), yymmdd(set), ~yymmdd(repeat)")
69 (today-help ", .(today)")
70 (help (cond ((and new pass-through)
72 ((and new (not pass-through))
73 (concat "RET(ok), " common-help today-help))
75 (concat "RET(list), " common-help today-help))
77 (error "Can't happen.")))))
78 (format "[%s] %s: " dow help)))
80 (defvar howm-date-current nil)
81 (make-variable-buffer-local 'howm-date-current)
83 (defun howm-action-lock-date-search (date)
84 (howm-set-command 'howm-action-lock-date-search)
87 (howm-action-lock-forward-escape)
88 (setq howm-date-current date)))
90 (defun howm-search-today ()
94 (defun howm-search-past (&optional days-before)
96 (let* ((n (or days-before 0))
97 (today (format-time-string howm-date-format))
98 (target (howm-datestr-shift today 0 0 (- n))))
99 (howm-action-lock-date-search target)))
101 (defun howm-action-lock-date-shift (n date)
102 (howm-datestr-replace (howm-datestr-shift date 0 0 n)))
104 (defun howm-action-lock-date-set (val date &optional future-p)
105 (howm-datestr-replace (howm-datestr-expand val date future-p)))
107 (defvar howm-action-lock-date-repeat-max 200)
108 (defun howm-action-lock-date-repeat (until date)
109 (let ((every (read-from-minibuffer "Every? [RET(all), num(days), w(week), m(month), y(year)] ")))
110 (let ((max-d (howm-datestr-expand until date t))
111 (offset-y (if (string= every "y") 1 0))
112 (offset-m (if (string= every "m") 1 0))
113 (offset-d (or (cdr (assoc every '(("y" . 0) ("m" . 0) ("w" . 7))))
114 (max (string-to-number every) 1))))
120 (setq d (howm-datestr-shift d offset-y offset-m offset-d))
121 (howm-datestr<= d max-d))
122 (when (and check (>= i howm-action-lock-date-repeat-max))
123 (if (y-or-n-p (format "More than %d lines. Continue? " i))
125 (throw 'too-many nil)))
126 (howm-duplicate-line)
127 (howm-datestr-replace d)
128 (setq i (+ i 1))))))))
130 (defun howm-make-datestr (y m d)
131 (let ((ti (encode-time 0 0 0 d m y)))
132 (format-time-string howm-date-format ti)))
134 (defun howm-datestr-parse (date)
135 (string-match howm-date-regexp date)
136 (mapcar (lambda (pos)
137 (string-to-number (match-string-no-properties pos date)))
138 (list howm-date-regexp-year-pos
139 howm-date-regexp-month-pos
140 howm-date-regexp-day-pos)))
142 (defun howm-datestr-to-time (date)
143 (let* ((ymd (howm-datestr-parse date))
147 (encode-time 0 0 0 d m y)))
149 (defun howm-time-to-datestr (&optional time)
150 (let ((x (decode-time time)))
151 (howm-make-datestr (nth 5 x) (nth 4 x) (nth 3 x))))
153 (defun howm-datestr-day-of-week (date)
154 (format-time-string "%a" (howm-datestr-to-time date)))
156 (defun howm-datestr-expand (date base &optional future-p)
157 (let* ((raw (howm-datestr-expand-general date base nil))
158 (future (howm-datestr-expand-general date base t))
160 (cond ((eq future-p 'closer)
161 (cl-labels ((to-f (d) (float-time (howm-datestr-to-time d)))
162 (delta (d1 d2) (abs (- (to-f d1) (to-f d2)))))
163 (if (< (delta raw base) (delta future base)) raw future)))
166 (unless (string= raw ret)
167 (message "Assume future date"))
170 (defun howm-datestr-expand-general (date base &optional future-p)
171 (let* ((base-ymd (howm-datestr-parse base))
172 (nval (format "%8s" date))
173 (given-ymd-str (mapcar (lambda (r)
174 (substring nval (car r) (cadr r)))
175 '((0 4) (4 6) (6 8))))
176 (ys (car given-ymd-str))
177 (ms (cadr given-ymd-str))
178 (ds (cl-caddr given-ymd-str)))
179 (when (string-match "^ +0+$" ys)
181 (let* ((given-ymd (mapcar #'string-to-number (list ys ms ds)))
182 (carry nil) ;; to force future date
183 (dmy (cl-mapcar (lambda (ox nx)
185 (when (and carry (= nx 0))
193 (reverse base-ymd) (reverse given-ymd)))
197 (howm-make-datestr (if (<= y 99) (+ y 2000) y) m d))))
199 (defun howm-datestr-shift (date y m d)
200 (let* ((ymd (howm-datestr-parse date))
204 (howm-make-datestr (+ oy y) (+ om m) (+ od d))))
206 (defun howm-datestr<= (date1 date2)
207 (or (string< date1 date2)
208 (string= date1 date2)))
210 (defun howm-datestr-replace (date)
212 (while (not (looking-at howm-date-regexp))
214 (replace-match date t t)
217 (defun howm-duplicate-line ()
218 (let ((c (current-column))
219 (s (buffer-substring (line-beginning-position) (line-end-position))))
224 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
225 ;; search for next/previous date
227 (defvar howm-date-forward-ymd-msg "Searching %s...")
228 (defvar howm-date-forward-ymd-limit 35)
229 (defun howm-date-forward-ymd (y m d)
230 (when (not howm-date-current)
231 (error "Not in date search."))
232 (let* ((new-date (howm-datestr-shift howm-date-current y m d))
234 (step (if (> (+ y m d) 0) +1 -1))
238 (when (howm-action-lock-date-search new-date)
240 (< c howm-date-forward-ymd-limit))
241 (setq new-date (howm-datestr-shift new-date 0 0 step))
243 (when howm-date-forward-ymd-msg
244 (format howm-date-forward-ymd-msg new-date)))
245 (error "Not found within %d days." howm-date-forward-ymd-limit))
246 (when (not (eq (current-buffer) b))
247 (with-current-buffer b
248 (howm-view-kill-buffer)))
249 (howm-view-summary-check t))))
251 (defmacro howm-date-defun-f/b (func y m d)
252 `(defun ,func (&optional k)
255 (howm-date-forward-ymd ,y ,m ,d))))
257 (howm-date-defun-f/b howm-date-forward 0 0 n)
258 (howm-date-defun-f/b howm-date-forward-month 0 n 0)
259 (howm-date-defun-f/b howm-date-forward-year n 0 0)
260 (howm-date-defun-f/b howm-date-backward 0 0 (- n))
261 (howm-date-defun-f/b howm-date-backward-month 0 (- n) 0)
262 (howm-date-defun-f/b howm-date-backward-year (- n) 0 0)
264 (let ((m howm-view-summary-mode-map))
265 (define-key m "+" 'howm-date-forward)
266 (define-key m "-" 'howm-date-backward)
267 (define-key m ")" 'howm-date-forward)
268 (define-key m "(" 'howm-date-backward)
269 (define-key m "}" 'howm-date-forward-month)
270 (define-key m "{" 'howm-date-backward-month)
271 (define-key m "]" 'howm-date-forward-year)
272 (define-key m "[" 'howm-date-backward-year)
275 ;;; howm-date.el ends here