OSDN Git Service

simply use autotools macro to set version numbers in *.el
[howm/howm.git] / howm-menu.el
1 ;;; howm-menu.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2015, 2016, 2017
3 ;;;   HIRAOKA Kazuyuki <khi@users.sourceforge.jp>
4 ;;; $Id: howm-menu.el,v 1.106 2012-09-23 11:34:59 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-menu)
23 (require 'howm)
24
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 ;; customize
27
28 ;;; general
29
30 (howm-defvar-risky howm-menu-mode-map nil)
31 (let ((m (make-keymap)))
32   (define-key m action-lock-magic-return-key 'howm-menu-invoke)
33   (define-key m [tab] 'action-lock-goto-next-link)
34   (define-key m [(meta tab)] 'action-lock-goto-previous-link)
35   (define-key m "\C-i" 'action-lock-goto-next-link)
36   (define-key m "\M-\C-i" 'action-lock-goto-previous-link)
37   (define-key m " " 'scroll-up)
38   (define-key m [backspace] 'scroll-down)
39   (define-key m "\C-h" 'scroll-down)
40   (define-key m "q" 'bury-buffer)
41   (define-key m "?" 'describe-mode)
42   (setq howm-menu-mode-map m)
43   )
44
45 ;;; schedule, todo, recent, random
46
47 ;; Set random seed.
48 ;; snap://Info-mode/elisp#Random Numbers
49 (defvar howm-randomize t)
50 (when howm-randomize
51   (random t))
52
53 (defvar howm-menu-reminder-format "> %s | %s"
54   "Format to show schedule/todo list in `howm-menu-mode'.")
55 (defvar howm-menu-list-format
56   (let* ((path (format-time-string howm-file-name-format))
57          (width (length (file-name-sans-extension
58                          (file-name-nondirectory path)))))
59     (concat "> %-" (format "%s" width) "s | %s"))
60   "Format to show recent/random list in `howm-menu-mode'.")
61 (defvar howm-menu-list-regexp "^\\(>\\([^|\r\n]*|\\)\\) +\\(.*\\)$"
62   "Regexp to find and parse schedule/todo/recent/random list in `howm-menu-mode'.
63 `howm-menu-list-regexp-action-pos' must cover header part.
64 Otherwise, `howm-action-lock-forward' may be invoked unintentionally.")
65 (defvar howm-menu-list-regexp-key-pos 3
66   "Position of target string for action-lock in history buffer.
67 This target is searched when action-lock is invoked.")
68 (defvar howm-menu-list-regexp-action-pos 1
69   "Position of action-lock hilight on schedule/todo/recent/random list
70 in `howm-menu-mode'.")
71 (defvar howm-menu-list-regexp-face-pos 2
72   "Position to apply `howm-menu-list-face' on schedule/todo/recent/random list
73 in `howm-menu-mode'.")
74
75 ;;; shortcut
76
77 ;; %"..." or %"...%"
78 (defvar howm-menu-key-regexp
79   "%\"\\(\\([^\r\n%\"]\\)[^\r\n%\"]*\\(%+[^\r\n%\"]+\\)*\\)\\(%\\)?\"")
80 (defvar howm-menu-key-regexp-word-pos 1)
81 (defvar howm-menu-key-regexp-key-pos 2)
82 (defvar howm-menu-key-regexp-moveonly-pos 4)
83
84 ;;; dynamic contents
85
86 (howm-defvar-risky howm-menu-allow
87   '(howm-menu-schedule
88     howm-menu-todo
89     howm-menu-reminder
90     howm-menu-recent
91     howm-menu-random
92     howm-menu-search
93     howm-menu-categorized-reminder
94     ))
95
96 (howm-defvar-risky howm-menu-display-rules
97   `(
98     ;; static
99     ("%sdays"    . "%here%howm-menu-schedule-days")
100     ("%tnum"     . "%here%howm-menu-todo-num")
101     ("%schedule" . "%here%(howm-menu-schedule)")
102     ("%todo"     . "%here%(howm-menu-todo)")
103     ("%reminder" . "%here%(howm-menu-reminder)")
104     ("%recent"   . "%here%(howm-menu-recent)")
105     ("%random"   . "%here%(howm-menu-random)")
106     ;; dynamic
107     ("%here%" . howm-menu-here)
108     (,howm-menu-key-regexp . howm-menu-shortcut)
109     )
110   "List of rules for dynamic contents in howm menu.
111 ((R1 . T1) (R2 . T2) ...):
112 Regexp R1 is replaced by T1 if T1 is a string.
113 (T1) is called at R1 if T1 is a function.")
114
115 ;;; command table
116
117 ;; howm-menu-command-table-* = ((MATCHER FUNC ONBUF) ...)
118 ;; 
119 ;; (FUNC) is evalueted on ONBUF when return key is hit on MATCHER.
120 ;; 
121 ;; MATCHER = regexp | (regexp position)
122 ;; (optional) ONBUF = nil | 'previous | 'current
123 ;;   nil: previous non-menu buffer (set-buffer)
124 ;;   'previous: previous non-menu buffer (switch-to-buffer)
125 ;;   'current: current menu buffer
126
127 (howm-defvar-risky howm-menu-command-table-common
128   '(
129     (("%eval%\\(.*$\\)" 1) howm-menu-eval previous)
130     (("%call%\\(.*$\\)" 1) howm-menu-call previous)
131      ))
132
133 ;;; which is opened as menu?
134
135 (howm-defvar-risky howm-menu-keyword-regexp "^%.*%$")
136 (howm-defvar-risky howm-menu-top "%menu%")
137
138 ;;; misc.
139
140 (howm-defvar-risky howm-menu-toggle-invisible "%|")
141
142 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
143 ;; internal
144
145 (defvar *howm-menu-force-refresh* nil) ;; dirty. clean me. [2003/09/29 21:39]
146
147 (defvar *howm-menu-shortcut-keys* nil)
148 (defvar *howm-menu-shortcut-multidef-keys* nil)
149 (defvar *howm-menu-shortcut-markers* nil)
150 (make-variable-buffer-local '*howm-menu-shortcut-markers*)
151
152 (defvar howm-menu-previous-buffer nil)
153 (defvar howm-menu-next-expiry-time (current-time))
154 (defvar howm-menu-last-time (current-time))
155 (defvar howm-menu-buffer-file nil)
156 (defvar howm-menu-buffer-file-place nil)
157 (howm-defvar-risky howm-menu-mode-local-map nil)
158 (make-variable-buffer-local 'howm-menu-previous-buffer)
159 (make-variable-buffer-local 'howm-menu-next-expiry-time)
160 (make-variable-buffer-local 'howm-menu-last-time)
161 (make-variable-buffer-local 'howm-menu-buffer-file)
162 (make-variable-buffer-local 'howm-menu-buffer-file-place)
163 (make-variable-buffer-local 'howm-menu-mode-local-map)
164
165 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
166 ;; mode
167
168 (defun howm-menu-mode ()
169   "howm menu
170 key     binding
171 ---     -------
172 \\[action-lock-magic-return]    Follow link
173 \\[action-lock-goto-next-link]  Next link
174 \\[action-lock-goto-previous-link]      Prev link
175 \\[describe-mode]       This help
176 \\[bury-buffer] Quit
177 "
178   (interactive)
179   (setq major-mode 'howm-menu-mode
180         mode-name "HM")
181   (setq howm-menu-mode-local-map (copy-keymap howm-menu-mode-map))
182   (use-local-map howm-menu-mode-local-map)
183   )
184
185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
186 ;; main
187
188 (defun howm-menu (&optional force-refresh last-chance)
189   (interactive)
190   (when (and (eq (howm-folder-type howm-directory) ':dir)
191              (not (file-exists-p howm-directory)))
192     (make-directory howm-directory t))
193   (let ((*howm-menu-force-refresh* force-refresh)
194         ;; force to use the original howm-directory
195         (*howm-independent-directories* nil))
196     (if (and howm-menu-keyword-regexp (null howm-menu-file))
197         (let ((m (howm-keyword-search howm-menu-top)))
198           (when (and (cdr (assoc 'menu-p m))
199                      (not (cdr (assoc 'keyword-matched m))))
200             (howm-menu-initialize-skel last-chance)))
201       (howm-menu-open howm-menu-file))))
202
203 (defun howm-menu-open (file &optional place name)
204   (setq name (or name (howm-menu-name file)))
205   (let ((f (if (file-name-absolute-p file)
206                file
207              (expand-file-name file howm-directory))))
208     (if (file-exists-p f)
209         (howm-menu-open-sub f place name)
210       (progn
211         (find-file f)
212         (howm-mode)))))
213
214 (defun howm-menu-open-sub (f place name)
215   (let* ((pb (current-buffer))
216          (pm major-mode)
217          (b (get-buffer name))
218          (mtime (nth 5 (file-attributes f))))
219     (if (or *howm-menu-force-refresh*
220             (null b)
221             (progn
222               (set-buffer b)
223               (or (howm-time< howm-menu-last-time mtime)
224                   (howm-time< howm-menu-next-expiry-time
225                               (current-time)))))
226         (howm-menu-refresh f place name)
227       (switch-to-buffer b))
228     (let ((cm major-mode))
229       (save-excursion
230         (while (eq pm cm)
231           (set-buffer pb)
232           (setq pb howm-menu-previous-buffer)
233           (set-buffer pb)
234           (setq pm major-mode)))
235       (setq howm-menu-previous-buffer pb))))
236
237 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
238 ;; refresh
239
240 (howm-defvar-risky howm-menu-shortcut-assoc nil)
241 (make-variable-buffer-local 'howm-menu-shortcut-assoc)
242 (howm-defvar-risky howm-menu-invisible t
243   "*Non nil if 'invisible' property should be used in menu.
244 This must be t at now.
245 When this is nil, delete-region is used instead, and bug appears.")
246
247 (defun howm-menu-refresh (&optional file place name)
248   (interactive)
249   ;; preprocess
250   (when name
251     (switch-to-buffer (get-buffer-create name)))
252   (howm-menu-mode)
253   (setq howm-menu-buffer-file (or file howm-menu-buffer-file))
254   (setq howm-menu-buffer-file-place (or place
255                                         howm-menu-buffer-file-place
256                                         1))
257   (setq howm-menu-shortcut-assoc nil)
258   ;; main
259   (howm-rewrite-read-only-buffer
260     (howm-menu-insert-paragraph howm-menu-buffer-file
261                                 howm-menu-buffer-file-place)
262     (howm-menu-dynamic-setup) ;; shotcut & dynamic contents
263     (howm-menu-set-face))
264   ;; postprocess
265   (goto-char (point-min))
266   (setq howm-menu-last-time (current-time))
267   (setq howm-menu-next-expiry-time
268         (howm-days-after (current-time) 0
269                          howm-menu-expiry-hours))
270   (howm-menu-shortcut-warn)
271   (run-hooks 'howm-menu-hook))
272
273 (defun howm-menu-insert-paragraph (file place)
274   (insert-file-contents (expand-file-name file
275                                           howm-directory))
276   (howm-view-set-place place)
277   (let* ((r (howm-view-paragraph-region))
278          (b (car r))
279          (e (cadr r)))
280     (delete-region e (point-max))
281     (delete-region (point-min) b))
282   (goto-char (point-max))
283   (insert (howm-menu-footer)))
284
285 ;; (defun howm-menu-dynamic-setup ()
286 ;;   (let* ((action-lock-default-rules (howm-menu-action-lock-rules)))
287 ;;     (if howm-mode
288 ;;         (howm-initialize-buffer)
289 ;;       (howm-mode 1)))
290 ;;   (howm-menu-shortcut-initialize)
291 ;;   (howm-menu-replace howm-menu-display-rules))
292
293 (defun howm-menu-dynamic-setup ()
294   (howm-menu-shortcut-initialize)
295   (howm-menu-replace howm-menu-display-rules)
296   (let* ((action-lock-default-rules (howm-menu-action-lock-rules)))
297     (if howm-mode
298         (howm-initialize-buffer)
299       (howm-mode 1))))
300
301 (defun howm-menu-set-face ()
302   (set (make-local-variable 'font-lock-keywords-only) t)
303   (howm-menu-add-font-lock)
304   (font-lock-fontify-buffer)
305   (when howm-menu-toggle-invisible
306     (howm-menu-make-invisible)))
307
308 (defun howm-menu-footer ()
309   (or howm-menu-footer
310       (let* ((r (howm-menu-command-table-raw))
311              (buttons (mapcar (lambda (f)
312                                 (cdr (assoc f
313                                             (mapcar (lambda (z)
314                                                       (cons (cadr z)
315                                                             (car z)))
316                                                     r))))
317                               '(howm-menu-refresh howm-menu-edit)))
318              (footer (apply #'concat `("\n-- \n" ,@buttons))))
319         (setq howm-menu-footer footer)
320         footer)))
321
322 (defun howm-menu-refresh-background ()
323   ;; save-current-buffer doesn't work on GNU Emacs 21.4.1
324   (let ((b (current-buffer)))
325     (howm-menu t)
326     (switch-to-buffer b)))
327
328 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
329 ;; action-lock
330
331 (defun howm-menu-invoke (arg)
332   (interactive "P")
333   (cond ((save-excursion
334            (beginning-of-line)
335            (looking-at howm-menu-list-regexp))
336          (beginning-of-line)
337          (action-lock-invoke arg))
338         ((howm-menu-list-get-item)
339          (howm-view-open-item (howm-menu-list-get-item)))
340         (t
341          (error "Not on spell string."))))
342
343 (defun howm-menu-action-lock-rules ()
344   (let* ((d action-lock-default-rules)
345          (f (howm-action-lock-reminder-forward-rules))
346          (j (howm-menu-list-rules))
347          (m (mapcar (lambda (pair)
348                       (let* ((h (car pair))
349                              (r (if (listp h) (car h) h))
350                              (n (if (listp h) (cadr h) nil))
351                              (args (if n
352                                        `(list (match-string-no-properties ,n))
353                                      nil))
354                              (functab (cdr pair))
355                              (c (howm-menu-action functab args)))
356                         (list r c)))
357                     (howm-menu-command-table))))
358     (append m d j f)))
359
360 ;; Elisp is not Scheme. Lambda is not closure. Don't forget dynamic binding.
361 ;; Check
362 ;;   (pp (car (howm-menu-action-lock-rules)))
363 ;; for debug. [2003/09/25]
364 (defun howm-menu-action (function-table args)
365   (let* ((func (car function-table))
366          (onbuf (cadr function-table))
367          (switch-p (eq onbuf 'previous)))
368     (let* ((s-buf (if (eq onbuf 'current) 'cur 'prev))
369            (s-switch `(switch-to-buffer ,s-buf))
370            (s-apply `(apply #',func ,(if args 'a nil))))
371 ;;            (s-apply `(apply #',func ,(if args '(list a) nil))))
372       (let* ((s-body (if switch-p
373                          `(progn ,s-switch ,s-apply)
374                        `(with-current-buffer ,s-buf ,s-apply))))
375         `(lambda (&optional ,howm-menu-action-arg)
376            (let ((a ,args)
377                  (cur (current-buffer))
378                  (prev (if (howm-buffer-alive-p howm-menu-previous-buffer)
379                            howm-menu-previous-buffer
380                          (current-buffer))))
381              ,s-body))))))
382
383 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
384 ;; shortcut
385
386 (defun howm-menu-shortcut-get-marker ()
387   (let ((m (make-marker)))
388     (set-marker m (point))
389     (add-to-list '*howm-menu-shortcut-markers* m)
390     m))
391
392 (defun howm-menu-shortcut-clear-markers ()
393   (mapc (lambda (m) (set-marker m nil))
394         *howm-menu-shortcut-markers*)
395   (setq *howm-menu-shortcut-markers* nil))
396
397 (defun howm-menu-shortcut-initialize ()
398   (setq *howm-menu-shortcut-keys* nil)
399   (setq *howm-menu-shortcut-multidef-keys* nil)
400   (howm-menu-shortcut-clear-markers))
401
402 (defun howm-menu-shortcut-sort (keys)
403   (mapconcat #'identity
404              (sort (copy-sequence keys) #'string<)
405              ""))
406
407 (defun howm-menu-shortcut-warn ()
408   (when *howm-menu-shortcut-multidef-keys*
409     (beep)
410     (message "Multiple definitions for key(s): \"%s\" in \"%s\""
411              (howm-menu-shortcut-sort *howm-menu-shortcut-multidef-keys*)
412              (howm-menu-shortcut-sort *howm-menu-shortcut-keys*))))
413
414 ;; Check howm-menu-mode-local-map if you want to debug howm-menu-shortcut.
415 (defun howm-menu-shortcut ()
416   (let* ((beg (match-beginning 0))
417          (end (match-end 0))
418          (wbeg (match-beginning howm-menu-key-regexp-word-pos))
419          (wend (match-end  howm-menu-key-regexp-word-pos))
420          (key (match-string-no-properties howm-menu-key-regexp-key-pos))
421          (move-only (match-beginning howm-menu-key-regexp-moveonly-pos)))
422     ;; 'end' must be first.
423     ;; howm-menu-invisible-region can be delete-region indeed,
424     ;; and points after the region can be slided.
425     (howm-menu-invisible-region wend end)
426     (howm-menu-invisible-region beg wbeg)
427     (let ((p (howm-menu-shortcut-get-marker)))
428       (setq howm-menu-shortcut-assoc
429             (cons (cons key p) howm-menu-shortcut-assoc))
430       (define-key howm-menu-mode-local-map key
431         (howm-menu-shortcut-func key p move-only)))
432     (when (member key *howm-menu-shortcut-keys*)
433       (setq *howm-menu-shortcut-multidef-keys*
434             (cons key *howm-menu-shortcut-multidef-keys*)))
435     (setq *howm-menu-shortcut-keys*
436           (cons key *howm-menu-shortcut-keys*))))
437
438 (defun howm-menu-shortcut-func (key p move-only)
439   (if howm-menu-invisible
440       (howm-menu-shortcut-func1 p move-only)
441     (howm-menu-shortcut-func2 key p move-only)))
442
443 ;; old code. it works.
444 (defun howm-menu-shortcut-func1 (p move-only)
445   `(lambda (arg)
446      (interactive "P")
447      (let ((pos ,p))
448        (if ,move-only
449            (goto-char pos)
450          (save-excursion
451            (goto-char pos)
452            (let ((case-fold-search nil)) ;; temporaly
453              (when (null (action-lock-get-action))
454                (action-lock-goto-next-link))
455              (action-lock-invoke arg)))))))
456
457 ;; new code. broken.
458 ;; It doesn't work because action can be
459 ;; (let ((s (match-string-no-properties 0))) (howm-keyword-search s nil nil)).
460 (defun howm-menu-shortcut-func2 (key p move-only)
461   (if move-only
462       `(lambda (arg) (interactive "P") (goto-char ,p))
463     (save-excursion
464       (goto-char p)
465       (let ((case-fold-search nil)) ;; temporaly
466         (when (null (action-lock-get-action))
467           (action-lock-goto-next-link))
468         (let ((action (action-lock-get-action)))
469           (if (null action)
470               (lambda (arg) (interactive "P") nil)
471             (progn
472               (rplacd (assoc key howm-menu-shortcut-assoc)
473                       action)
474               `(lambda (arg)
475                  (interactive "P")
476                  (funcall (cdr (assoc ,key howm-menu-shortcut-assoc))
477                           arg)))))))))
478
479 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
480 ;; action
481
482 (defun howm-menu-edit ()
483   (interactive)
484   (let ((place howm-menu-buffer-file-place))
485     (find-file (expand-file-name howm-menu-buffer-file howm-directory))
486     (howm-mode t)
487     (when place
488       (howm-view-set-place place)
489       (recenter 0))))
490
491 (defun howm-menu-eval (s)
492   (let ((expr (read s)))
493     (eval expr)))
494
495 (defun howm-menu-call (s)
496   (let ((expr (read s)))
497     (call-interactively expr)))
498
499 (defun howm-open-today ()
500   (interactive)
501   (and (howm-create-file t)
502        (howm-insert-template ""))
503   (howm-set-mode))
504
505 (defun howm-open-past (&optional days-before)
506   (interactive "p")
507   (setq days-before (or days-before 1))
508   (if (= days-before 0)
509       (howm-open-today)
510     (howm-open-past-sub days-before)))
511
512 (defun howm-open-past-sub (days-before)
513   (let ((f (expand-file-name (howm-file-name (howm-days-after (current-time)
514                                                               (- days-before)))
515                              howm-directory)))
516     (if (file-exists-p f)
517         (find-file f)
518       (error "No such file: %s" f)))
519   (howm-set-mode))
520
521 (defun howm-find-past (&optional days-before)
522   (interactive "p")
523   (cond ((howm-one-file-one-day-p) (howm-open-past days-before))
524         (t (howm-search-past days-before))))
525
526 (defun howm-find-today (&optional days-before)
527   (interactive "P")
528   (howm-find-past (or days-before 0)))
529
530 (defun howm-find-yesterday (&optional days-before)
531   (interactive)
532   (howm-find-past (or days-before 1)))
533
534 (defun howm-one-file-one-day-p ()
535   (let* ((now (decode-time))
536          (d (nth 3 now))
537          (m (nth 4 now))
538          (y (nth 5 now))
539          (beginning-of-day (encode-time 0 0 0 d m y))
540          (end-of-day (encode-time 59 59 23 d m y)))
541     (string= (howm-file-name beginning-of-day)
542              (howm-file-name end-of-day))))
543
544 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
545 ;; face
546
547 (defun howm-menu-make-invisible ()
548   (save-excursion
549     (goto-char (point-min))
550     (let (visible-p
551           invisible-beg)
552       (while (not (= (point) (point-max)))
553         (setq visible-p t)
554         (while (re-search-forward howm-menu-toggle-invisible
555                                   (line-end-position) t)
556           (if visible-p
557               (setq invisible-beg (match-beginning 0))
558             (howm-menu-invisible-region invisible-beg (match-end 0)))
559           (setq visible-p (not visible-p)))
560         (when (not visible-p)
561           (howm-menu-invisible-region invisible-beg
562                                       (save-excursion (forward-line) (point))))
563         (forward-line)))))
564
565 (defun howm-menu-font-lock-rules ()
566   `((,howm-menu-key-regexp
567      (,howm-menu-key-regexp-key-pos howm-menu-key-face t))
568     ;; In menu-list form "> FILE-NAME | ",
569     ;; I want to hide annoying long underlines drawn by action-lock.
570     (,howm-menu-list-regexp
571      (,howm-menu-list-regexp-face-pos howm-menu-list-face t))
572     ;; But some users may want to highlight today's YYYY-MM-DD even if
573     ;; it is a part of a FILE-NAME.
574     ;; The next code makes duplicated entries; they are already put into
575     ;; font-lock-keywords by howm-reminder-add-font-lock
576     ;; in howm-initialize-buffer because menu is howm-mode.
577     ;; They are hidden by the above rule in FILE-NAME columns,
578     ;; and I need to put them again now. Sigh...
579     ;; Clean me!
580     ,@(howm-reminder-today-font-lock-keywords)))
581 (defun howm-menu-add-font-lock ()
582   (cheat-font-lock-append-keywords (howm-menu-font-lock-rules)))
583
584 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
585 ;; dynamic contents
586
587 (defun howm-menu-replace (rules)
588   (mapc (lambda (pair)
589           (let* ((reg (car pair))
590                  (to (cdr pair)))
591             (goto-char (point-min))
592             (while (re-search-forward reg nil t)
593               (cond ((stringp to) (replace-match to))
594                     ((functionp to) (funcall to))
595                     (t (error "Invalid to-part: %s." to))))))
596         rules))
597
598 ;; (defun howm-menu-func ()
599 ;;   (let ((b (match-beginning 0))
600 ;;         (e (match-end 0))
601 ;;         (f (read (match-string-no-properties 1))))
602 ;;     (if (or (eq howm-menu-allow t)
603 ;;             (member f howm-menu-allow))
604 ;;         (howm-replace-region b e (funcall f))
605 ;;       (message "%s is not allowed." f))))
606
607 ;; (defun howm-menu-var ()
608 ;;   (let ((b (match-beginning 0))
609 ;;         (e (match-end 0))
610 ;;         (f (read (match-string-no-properties 1))))
611 ;;     (howm-replace-region b e (eval f))))
612
613 (defun howm-menu-here ()
614   (let* ((beg (match-beginning 0))
615          (expr-beg (match-end 0))
616          (expr-end (progn (forward-sexp) (point)))
617          (expr (read (buffer-substring-no-properties expr-beg expr-end))))
618     (cond ((symbolp expr) (howm-menu-here-var expr beg expr-end))
619           ((listp expr) (howm-menu-here-func (car expr) (cdr expr)
620                                               beg expr-end))
621           (t (message "Unknown expr: %s" expr)))))
622
623 (defun howm-menu-here-var (expr beg end)
624   (if (boundp expr)
625       (howm-replace-region beg end (symbol-value expr))
626     (message "Unknown symbol: %s" expr)))
627
628 (defun howm-menu-here-func (func args beg end)
629 ;;   (let ((allowed (or (eq howm-menu-allow t) (member func howm-menu-allow))))
630   (let ((allowed (member func howm-menu-allow)))
631     (cond ((not allowed) (message "Not allowed: %s" func))
632           ((not (fboundp func)) (message "Unknown function: %s" func))
633           (t (howm-replace-region beg end (apply func args))))))
634
635 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
636 ;; schedule, todo, recent, random
637
638 ;;; command
639
640 (defun howm-menu-schedule ()
641   (howm-menu-general "schedule" 'schedule
642                      (howm-schedule-menu howm-menu-schedule-days
643                                          howm-menu-schedule-days-before)))
644
645 (defvar howm-menu-todo-show-day-of-week t)
646 (defun howm-menu-todo ()
647   (howm-menu-general "todo" 'todo
648                      (howm-todo-menu howm-menu-todo-num
649                                      howm-menu-todo-priority
650                                      howm-menu-reminder-separators)))
651 (defun howm-menu-reminder ()
652   (howm-menu-general "reminder" 'todo
653                      (howm-reminder-menu howm-menu-todo-num
654                                          howm-menu-todo-priority
655                                          howm-menu-reminder-separators)))
656
657 (defun howm-menu-recent (&optional evaluator label)
658   (howm-menu-general (or label "recent")
659                      nil
660                      (howm-recent-menu howm-menu-recent-num evaluator)))
661
662 (defun howm-menu-random () (howm-menu-recent t "random"))
663
664 (defun howm-menu-general (label formatter item-list)
665   "Generate output string for items in howm menu.
666 LABEL is only used for message.
667 FORMATTER is a function which receives an item and returns an output string
668  (without newline).
669 FORMATTER can be nil for standard style, 'todo for todo style,
670 'schedule for schedule style, or 'full for full note.
671 ITEM-LIST is list of items which should be shown."
672   (let ((f (cond ((null formatter) #'howm-menu-format-item)
673                  ((eq 'todo formatter) #'howm-menu-format-todo)
674                  ((eq 'schedule formatter) #'howm-menu-format-reminder)
675                  ((eq 'full formatter) #'howm-menu-format-full)
676                  (t formatter))))
677     (let* ((msg "scanning %s...")
678            (msg-done (concat msg "done")))
679       (message msg label)
680       ;;     (delete-region (match-beginning 0) (match-end 0))
681       (prog1
682           (mapconcat f item-list "\n")
683         (message msg-done label)))))
684
685 ;;; schedule/todo
686
687 (defun howm-menu-format-todo (item)
688   ;; item can be a separator.
689   (if (eq (howm-page-type (howm-item-page item)) ':nil)
690       (howm-item-summary item)
691     (let ((dow-str (cond (howm-menu-todo-show-day-of-week nil)
692                          (t "  "))))
693       (howm-menu-format-reminder item dow-str t))))
694
695 (defun howm-menu-format-reminder (item &optional day-of-week-str show-priority)
696   (let* ((p (howm-todo-parse item))
697          (late (floor (car p)))
698          (dow (cl-cadddr p))
699          (dow-str (or day-of-week-str
700                       (howm-day-of-week-string dow)))
701          (priority (if (and howm-menu-todo-priority-format
702                             show-priority)
703                        (format howm-menu-todo-priority-format
704                                (howm-todo-priority item))
705                      ""))
706          (h (format "%s%3s%s" dow-str late priority)))
707     (howm-menu-list-format h (howm-view-item-summary item) item
708                            howm-menu-reminder-format)))
709
710 (defun howm-day-of-week-string (&optional day-of-week)
711   ;; 0 = Sunday
712   (let ((dow (or day-of-week (nth 6 (decode-time))))
713         (names (howm-day-of-week)))
714     (cond ((stringp names) (substring names dow (1+ dow))) ;; backward compatibility
715           ((listp names) (nth dow names))
716           (t "  "))))
717
718 (defun howm-menu-format-full (item)
719   (let ((text (format "%s %s\n%s"
720                       howm-ref-header
721                       (howm-item-name item)
722                       (with-temp-buffer
723                         (howm-page-insert (howm-item-page item))
724                         (howm-view-set-place (howm-view-item-place item))
725                         (apply 'buffer-substring-no-properties
726                                (howm-view-paragraph-region))))))
727     (howm-menu-list-put-item text item)
728     text))
729
730 ;;; recent/random
731
732 (defun howm-recent-menu (num &optional evaluator)
733   ;; Bug: (length howm-recent-menu) can be smaller than NUM
734   ;; when empty files exist.
735   (let* ((randomp (eq evaluator t))
736          (summarizer #'(lambda (file line content) content))
737          ;; Unique name is needed for dynamic binding. Sigh...
738          (h-r-m-evaluator (if randomp
739                               (lambda (f) (number-to-string (random)))
740                             (or evaluator #'howm-view-mtime)))
741          (sorted (howm-sort (lambda (f) (funcall h-r-m-evaluator f))
742                             #'howm-view-string>
743                             (mapcar #'howm-item-name
744                                     (howm-folder-items howm-directory t))))
745          (files (howm-first-n sorted num)))
746     (let ((r (howm-menu-recent-regexp)))
747       (if randomp
748           (cl-mapcan (lambda (f)
749                             (let ((is (howm-view-search-items r (list f)
750                                                               summarizer)))
751                               (and is (list (nth (random (length is))
752                                                  is)))))
753                           files)
754         (howm-first-n (howm-view-search-items r files summarizer) num)))))
755
756 (defun howm-menu-recent-regexp ()
757   (or howm-menu-recent-regexp (howm-view-title-regexp-grep)))
758
759 ;;; common
760
761 (defun howm-menu-list-put-item (text item)
762   ;; put it to whole text, because I don't assume "> ..." format here.
763   (put-text-property 0 (length text) 'howm-menu-list-item item text))
764 (defun howm-menu-list-get-item (&optional text)
765   (get-text-property (if text 0 (point)) 'howm-menu-list-item text))
766 (defun howm-menu-list-getput-item (from-text to-text)
767   (howm-menu-list-put-item to-text
768                            (howm-menu-list-get-item from-text)))
769
770 (defun howm-menu-list-action (&optional keyword)
771   (let ((item (howm-menu-list-get-item keyword)))
772     (cond (item (howm-view-open-item item)) ;; schedule, todo, etc.
773           (keyword (howm-keyword-search keyword)) ;; history
774           (t (error "Target is not specified."))))) ;; can't happen
775
776 (defun howm-menu-format-item (item &optional list-format)
777   (let* ((info (file-name-sans-extension (howm-view-item-basename item)))
778          (line (howm-view-item-summary item)))
779     (howm-menu-list-format info line item list-format)))
780
781 (defun howm-menu-list-format (info line item &optional list-format)
782   (let ((s (format (or list-format howm-menu-list-format) info line)))
783     (howm-menu-list-put-item s item)
784     s))
785
786 (defun howm-menu-list-rules ()
787   (list (action-lock-general #'howm-menu-list-action
788                              howm-menu-list-regexp
789                              howm-menu-list-regexp-key-pos
790                              howm-menu-list-regexp-action-pos)))
791
792 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
793 ;; embed search result
794
795 (defun howm-menu-search (key &optional formatter regexp-p)
796   "Embed search result of KEY into menu.
797 See `howm-menu-general' for FORMATTER.
798 KEY is a regular expression if REGEXP-P is not nil.
799
800 Bugs: If you write %here%(howm-menu-search \"foo\" full) in your menu,
801 - menu file itself is also searched.
802 Write %here%(howm-menu-search \"[f]oo\" full t) insteadly.
803 - same note is shown twice if \"foo\" is hit twice in it."
804   (let ((fixed-p (not regexp-p)))
805     (howm-menu-general "menu-search"
806                        formatter
807                        (howm-view-search-folder-items key (howm-folder)
808                                                       nil fixed-p))))
809
810 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
811 ;; categorized todo-list
812
813 ;; Experimental [2006-01-16]
814
815 (defun howm-menu-classified-reminder (classifier &optional comparer
816                                                  title-format)
817   "Generate string of classified reminder-list.
818 CLASSIFIER is a function which receives an item and answers its class.
819 Class can be an arbitrary lisp object.
820 When class is nil, corresponding item is not shown in this list.
821 COMPARER is a function which receives two keys and answer t or nil.
822 It is used for sorting of keys.
823 TITLE-FORMAT is a format string for class title."
824   (let* ((a (howm-classify classifier
825                            (howm-reminder-menu nil
826                                                howm-menu-todo-priority
827                                                nil)))
828          ;; key 'nil' is skipped.
829          (keys (remove nil (mapcar #'car a)))
830          (tform (concat (or title-format "--%s--") "\n")))
831     (when comparer
832       (setq keys (sort keys comparer)))
833     (mapconcat (lambda (k)
834                  (let* ((item-list (howm-first-n (cdr (assoc k a))
835                                                  howm-menu-todo-num))
836                         (is (howm-with-reminder-setting
837                               (howm-todo-insert-separators
838                                item-list
839                                howm-menu-reminder-separators
840                                t))))
841                    (concat (format tform k)
842                            (howm-menu-general (format "reminder(%s)" k) 'todo
843                                               is))))
844                keys "\n")))
845
846 (defun howm-menu-categorized-reminder (categories &optional title-format
847                                                   erase-p omit-misc-p)
848   "Generate string of categorized reminder-list.
849
850 Write %here%(howm-menu-categorized-reminder (\"foo\" \"bar\" \"baz\"))
851 to show categorized list in menu. (You don't need quote(')
852 before the above list; arguments are not evaluated in %here%
853 because I don't have enough courage to call eval.)
854
855 If you like to erase category label from summary string, try
856 %here%(howm-menu-categorized-reminder (\"foo\" \"bar\" \"baz\") nil t)
857 instead.
858
859 If you don't like misc. category, try
860 %here%(howm-menu-categorized-reminder (\"foo\" \"bar\" \"baz\") nil nil t)."
861   ;; Using categories, matcher, etc. in lambda is bad indeed
862   ;; because of dynamic binding.
863   (let* ((matcher (lambda (cat str item)
864                     (and (string-match (regexp-quote cat) str)
865                          (progn
866                            (when erase-p
867                              (howm-item-set-summary item
868                                                     (replace-match "" nil nil
869                                                                    str)))
870                            t))))
871          (classifier (lambda (item)
872                        (let ((s (howm-item-summary item)))
873                          (or (cl-find-if (lambda (c)
874                                                 (funcall matcher c s item))
875                                               categories)
876                              (if omit-misc-p nil "misc.")))))
877          (pos (lambda (c) (or (cl-position c categories) howm-infinity)))
878          (comparer (lambda (a b) (< (funcall pos a) (funcall pos b)))))
879     (howm-menu-classified-reminder classifier comparer title-format)))
880
881 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
882 ;; generate initial menu
883
884 (defun howm-menu-initialize-skel (&optional dummy)
885   (let ((menu-name (howm-get-symbol nil "howm-menu-" howm-menu-lang)))
886     (require menu-name)
887     (howm-menu-copy-skel (symbol-value menu-name))
888     (howm-view-kill-buffer)
889     (howm-menu nil t)))
890
891 (defun howm-menu-copy-skel (contents)
892   (let ((menu-file (or howm-menu-file
893                        (expand-file-name "0000-00-00-000000.txt"
894                                          howm-directory)))
895         (r "^="))
896     (if (file-exists-p menu-file)
897         ;; I have no courage to erase existing file.
898         (progn
899           (setq howm-menu-file menu-file)
900           (message "Assume %s as menu file." menu-file))
901       (progn
902         (find-file menu-file)
903         (insert contents)
904         (goto-char (point-min))
905         (while (re-search-forward r nil t)
906           (replace-match howm-view-title-header nil nil))
907         (howm-mode 1)
908         (save-buffer)))))
909
910 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
911 ;; switch language
912
913 (defun howm-require-lang (&optional lang)
914   (require (howm-get-symbol nil "howm-lang-" (or lang howm-menu-lang))))
915
916 (defun howm-lang-ref (var)
917   (let ((lang howm-menu-lang))
918     (howm-require-lang lang)
919     ;; For backward compatibility, I use howm-day-of-week-en
920     ;; rather than howm-day-of-week:en.
921     (symbol-value (howm-get-symbol t var "-" lang))))
922
923 (defun howm-menu-command-table-raw ()
924   (howm-lang-ref "howm-menu-command-table"))
925
926 (defun howm-menu-command-table ()
927   (append howm-menu-command-table-common
928           (mapcar (lambda (pair) (cons (regexp-quote (car pair)) (cdr pair)))
929                   (howm-menu-command-table-raw))))
930
931 (defun howm-day-of-week ()
932   (howm-lang-ref "howm-day-of-week"))
933
934 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
935 ;; misc.
936
937 (defun howm-menu-p ()
938   (string= major-mode "howm-menu-mode"))
939
940 (defun howm-menu-name (file)
941   (format howm-menu-name-format file))
942
943 (defun howm-buffer-alive-p (buf)
944   (and buf (buffer-name buf)))
945
946 (defun howm-menu-keyword-p (keyword)
947   (and howm-menu-keyword-regexp
948        (stringp keyword) ;; perhaps unnecessary
949        (string-match howm-menu-keyword-regexp keyword)))
950
951 (defun howm-time< (t1 t2)
952   (or (< (car t1) (car t2))
953       (and (= (car t1) (car t2))
954            (< (cadr t1) (cadr t2)))))
955
956 (defun howm-menu-invisible-region (beg end)
957   (if howm-menu-invisible
958       (put-text-property beg end 'invisible t)
959     (delete-region beg end))
960 ;;   (put-text-property beg end 'intangible t)
961   )
962
963 ;;; howm-menu.el ends here