1 ;;; howm-menu.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2002, 2003, 2004, 2005-2020
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
44 ;;; schedule, todo, recent, random
47 ;; snap://Info-mode/elisp#Random Numbers
48 (defvar howm-randomize t)
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'.")
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)
85 (howm-defvar-risky howm-menu-allow
92 howm-menu-categorized-reminder
95 (howm-defvar-risky howm-menu-display-rules
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)")
106 ("%here%" . howm-menu-here)
107 (,howm-menu-key-regexp . howm-menu-shortcut)
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.")
116 ;; howm-menu-command-table-* = ((MATCHER FUNC ONBUF) ...)
118 ;; (FUNC) is evalueted on ONBUF when return key is hit on MATCHER.
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
126 (howm-defvar-risky howm-menu-command-table-common
128 (("%eval%\\(.*$\\)" 1) howm-menu-eval previous)
129 (("%call%\\(.*$\\)" 1) howm-menu-call previous)
132 ;;; which is opened as menu?
134 (howm-defvar-risky howm-menu-keyword-regexp "^%.*%$")
135 (howm-defvar-risky howm-menu-top "%menu%")
139 (howm-defvar-risky howm-menu-toggle-invisible "%|")
141 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
144 (defvar *howm-menu-force-refresh* nil) ;; dirty. clean me. [2003/09/29 21:39]
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*)
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)
164 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
167 (defun howm-menu-mode ()
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
178 (setq major-mode 'howm-menu-mode
180 (setq howm-menu-mode-local-map (copy-keymap howm-menu-mode-map))
181 (use-local-map howm-menu-mode-local-map)
184 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
187 (defun howm-menu (&optional force-refresh last-chance)
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))))
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)
206 (expand-file-name file howm-directory))))
207 (if (file-exists-p f)
208 (howm-menu-open-sub f place name)
213 (defun howm-menu-open-sub (f place name)
214 (let* ((pb (current-buffer))
216 (b (get-buffer name))
217 (mtime (nth 5 (file-attributes f))))
218 (if (or *howm-menu-force-refresh*
222 (or (howm-time< howm-menu-last-time mtime)
223 (howm-time< howm-menu-next-expiry-time
225 (howm-menu-refresh f place name)
226 (switch-to-buffer b))
227 (let ((cm major-mode))
231 (setq pb howm-menu-previous-buffer)
233 (setq pm major-mode)))
234 (setq howm-menu-previous-buffer pb))))
236 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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.")
246 (defun howm-menu-refresh (&optional file place name)
250 (switch-to-buffer (get-buffer-create name)))
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
256 (setq howm-menu-shortcut-assoc nil)
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))
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))
272 (defun howm-menu-insert-paragraph (file place)
273 (insert-file-contents (expand-file-name file
275 (howm-view-set-place place)
276 (let* ((r (howm-view-paragraph-region))
279 (delete-region e (point-max))
280 (delete-region (point-min) b))
281 (goto-char (point-max))
282 (insert (howm-menu-footer)))
284 ;; (defun howm-menu-dynamic-setup ()
285 ;; (let* ((action-lock-default-rules (howm-menu-action-lock-rules)))
287 ;; (howm-initialize-buffer)
289 ;; (howm-menu-shortcut-initialize)
290 ;; (howm-menu-replace howm-menu-display-rules))
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)))
297 (howm-initialize-buffer)
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)))
307 (defun howm-menu-footer ()
309 (let* ((r (howm-menu-command-table-raw))
310 (buttons (mapcar (lambda (f)
316 '(howm-menu-refresh howm-menu-edit)))
317 (footer (apply #'concat `("\n-- \n" ,@buttons))))
318 (setq howm-menu-footer footer)
321 (defun howm-menu-refresh-background ()
322 ;; save-current-buffer doesn't work on GNU Emacs 21.4.1
323 (let ((b (current-buffer)))
325 (switch-to-buffer b)))
327 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
330 (defun howm-menu-invoke (arg)
332 (cond ((save-excursion
334 (looking-at howm-menu-list-regexp))
336 (action-lock-invoke arg))
337 ((howm-menu-list-get-item)
338 (howm-view-open-item (howm-menu-list-get-item)))
340 (error "Not on spell string."))))
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))
351 `(list (match-string-no-properties ,n))
354 (c (howm-menu-action functab args)))
356 (howm-menu-command-table))))
359 ;; Elisp is not Scheme. Lambda is not closure. Don't forget dynamic binding.
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)
376 (cur (current-buffer))
377 (prev (if (howm-buffer-alive-p howm-menu-previous-buffer)
378 howm-menu-previous-buffer
382 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
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))
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))
401 (defun howm-menu-shortcut-sort (keys)
402 (mapconcat #'identity
403 (sort (copy-sequence keys) #'string<)
406 (defun howm-menu-shortcut-warn ()
407 (when *howm-menu-shortcut-multidef-keys*
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*))))
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))
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*))))
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)))
442 ;; old code. it works.
443 (defun howm-menu-shortcut-func1 (p move-only)
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)))))))
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)
461 `(lambda (arg) (interactive "P") (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)))
469 (lambda (arg) (interactive "P") nil)
471 (rplacd (assoc key howm-menu-shortcut-assoc)
475 (funcall (cdr (assoc ,key howm-menu-shortcut-assoc))
478 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
481 (defun howm-menu-edit ()
483 (let ((place howm-menu-buffer-file-place))
484 (find-file (expand-file-name howm-menu-buffer-file howm-directory))
487 (howm-view-set-place place)
490 (defun howm-menu-eval (s)
491 (let ((expr (read s)))
494 (defun howm-menu-call (s)
495 (let ((expr (read s)))
496 (call-interactively expr)))
498 (defun howm-open-today ()
500 (and (howm-create-file t)
501 (howm-insert-template ""))
504 (defun howm-open-past (&optional days-before)
506 (setq days-before (or days-before 1))
507 (if (= days-before 0)
509 (howm-open-past-sub days-before)))
511 (defun howm-open-past-sub (days-before)
512 (let ((f (expand-file-name (howm-file-name (howm-days-after (current-time)
515 (if (file-exists-p f)
517 (error "No such file: %s" f)))
520 (defun howm-find-past (&optional days-before)
522 (cond ((howm-one-file-one-day-p) (howm-open-past days-before))
523 (t (howm-search-past days-before))))
525 (defun howm-find-today (&optional days-before)
527 (howm-find-past (or days-before 0)))
529 (defun howm-find-yesterday (&optional days-before)
531 (howm-find-past (or days-before 1)))
533 (defun howm-one-file-one-day-p ()
534 (let* ((now (decode-time))
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))))
543 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
546 (defun howm-menu-make-invisible ()
548 (goto-char (point-min))
551 (while (not (= (point) (point-max)))
553 (while (re-search-forward howm-menu-toggle-invisible
554 (line-end-position) t)
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))))
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...
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)))
583 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
586 (defun howm-menu-replace (rules)
588 (let* ((reg (car 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))))))
597 ;; (defun howm-menu-func ()
598 ;; (let ((b (match-beginning 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))))
606 ;; (defun howm-menu-var ()
607 ;; (let ((b (match-beginning 0))
609 ;; (f (read (match-string-no-properties 1))))
610 ;; (howm-replace-region b e (eval f))))
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)
620 (t (message "Unknown expr: %s" expr)))))
622 (defun howm-menu-here-var (expr beg end)
624 (howm-replace-region beg end (symbol-value expr))
625 (message "Unknown symbol: %s" expr)))
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))))))
634 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
635 ;; schedule, todo, recent, random
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)))
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)))
656 (defun howm-menu-recent (&optional evaluator label)
657 (howm-menu-general (or label "recent")
659 (howm-recent-menu howm-menu-recent-num evaluator)))
661 (defun howm-menu-random () (howm-menu-recent t "random"))
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
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)
676 (let* ((msg "scanning %s...")
677 (msg-done (concat msg "done")))
679 ;; (delete-region (match-beginning 0) (match-end 0))
681 (mapconcat f item-list "\n")
682 (message msg-done label)))))
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)
692 (howm-menu-format-reminder item dow-str t))))
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)))
698 (dow-str (or day-of-week-str
699 (howm-day-of-week-string dow)))
700 (priority (if (and howm-menu-todo-priority-format
702 (format howm-menu-todo-priority-format
703 (howm-todo-priority item))
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)))
709 (defun howm-day-of-week-string (&optional day-of-week)
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))
717 (defun howm-menu-format-full (item)
718 (let ((text (format "%s %s\n%s"
720 (howm-item-name item)
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)
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))
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)))
747 (cl-mapcan (lambda (f)
748 (let ((is (howm-view-search-items r (list f)
750 (and is (list (nth (random (length is))
753 (howm-first-n (howm-view-search-items r files summarizer) num)))))
755 (defun howm-menu-recent-regexp ()
756 (or howm-menu-recent-regexp (howm-view-title-regexp-grep)))
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)))
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
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)))
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)
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)))
791 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
792 ;; embed search result
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.
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"
806 (howm-view-search-folder-items key (howm-folder)
809 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
810 ;; categorized todo-list
812 ;; Experimental [2006-01-16]
814 (defun howm-menu-classified-reminder (classifier &optional comparer
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
827 ;; key 'nil' is skipped.
828 (keys (remove nil (mapcar #'car a)))
829 (tform (concat (or title-format "--%s--") "\n")))
831 (setq keys (sort keys comparer)))
832 (mapconcat (lambda (k)
833 (let* ((item-list (howm-first-n (cdr (assoc k a))
835 (is (howm-with-reminder-setting
836 (howm-todo-insert-separators
838 howm-menu-reminder-separators
840 (concat (format tform k)
841 (howm-menu-general (format "reminder(%s)" k) 'todo
845 (defun howm-menu-categorized-reminder (categories &optional title-format
847 "Generate string of categorized reminder-list.
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.)
854 If you like to erase category label from summary string, try
855 %here%(howm-menu-categorized-reminder (\"foo\" \"bar\" \"baz\") nil t)
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)
866 (howm-item-set-summary item
867 (replace-match "" nil nil
870 (classifier (lambda (item)
871 (let ((s (howm-item-summary item)))
872 (or (cl-find-if (lambda (c)
873 (funcall matcher c s item))
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)))
880 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
881 ;; generate initial menu
883 (defun howm-menu-initialize-skel (&optional dummy)
884 (let ((menu-name (howm-get-symbol nil "howm-menu-" howm-menu-lang)))
886 (howm-menu-copy-skel (symbol-value menu-name))
887 (howm-view-kill-buffer)
890 (defun howm-menu-copy-skel (contents)
891 (let ((menu-file (or howm-menu-file
892 (expand-file-name "0000-00-00-000000.txt"
895 (if (file-exists-p menu-file)
896 ;; I have no courage to erase existing file.
898 (setq howm-menu-file menu-file)
899 (message "Assume %s as menu file." menu-file))
901 (find-file menu-file)
903 (goto-char (point-min))
904 (while (re-search-forward r nil t)
905 (replace-match howm-view-title-header nil nil))
909 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
912 (defun howm-require-lang (&optional lang)
913 (require (howm-get-symbol nil "howm-lang-" (or lang howm-menu-lang))))
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))))
922 (defun howm-menu-command-table-raw ()
923 (howm-lang-ref "howm-menu-command-table"))
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))))
930 (defun howm-day-of-week ()
931 (howm-lang-ref "howm-day-of-week"))
933 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
936 (defun howm-menu-p ()
937 (string= major-mode "howm-menu-mode"))
939 (defun howm-menu-name (file)
940 (format howm-menu-name-format file))
942 (defun howm-buffer-alive-p (buf)
943 (and buf (buffer-name buf)))
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)))
950 (defun howm-time< (t1 t2)
951 (or (< (car t1) (car t2))
952 (and (= (car t1) (car t2))
953 (< (cadr t1) (cadr t2)))))
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)
962 ;;; howm-menu.el ends here