OSDN Git Service

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