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 $
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)
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.
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,
20 ;;;--------------------------------------------------------------------
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
45 ;;; schedule, todo, recent, random
48 ;; snap://Info-mode/elisp#Random Numbers
49 (defvar howm-randomize t)
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'.")
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)
86 (howm-defvar-risky howm-menu-allow
93 howm-menu-categorized-reminder
96 (howm-defvar-risky howm-menu-display-rules
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)")
107 ("%here%" . howm-menu-here)
108 (,howm-menu-key-regexp . howm-menu-shortcut)
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.")
117 ;; howm-menu-command-table-* = ((MATCHER FUNC ONBUF) ...)
119 ;; (FUNC) is evalueted on ONBUF when return key is hit on MATCHER.
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
127 (howm-defvar-risky howm-menu-command-table-common
129 (("%eval%\\(.*$\\)" 1) howm-menu-eval previous)
130 (("%call%\\(.*$\\)" 1) howm-menu-call previous)
133 ;;; which is opened as menu?
135 (howm-defvar-risky howm-menu-keyword-regexp "^%.*%$")
136 (howm-defvar-risky howm-menu-top "%menu%")
140 (howm-defvar-risky howm-menu-toggle-invisible "%|")
142 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
145 (defvar *howm-menu-force-refresh* nil) ;; dirty. clean me. [2003/09/29 21:39]
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*)
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)
165 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
168 (defun howm-menu-mode ()
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
179 (setq major-mode 'howm-menu-mode
181 (setq howm-menu-mode-local-map (copy-keymap howm-menu-mode-map))
182 (use-local-map howm-menu-mode-local-map)
185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
188 (defun howm-menu (&optional force-refresh last-chance)
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))))
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)
207 (expand-file-name file howm-directory))))
208 (if (file-exists-p f)
209 (howm-menu-open-sub f place name)
214 (defun howm-menu-open-sub (f place name)
215 (let* ((pb (current-buffer))
217 (b (get-buffer name))
218 (mtime (nth 5 (file-attributes f))))
219 (if (or *howm-menu-force-refresh*
223 (or (howm-time< howm-menu-last-time mtime)
224 (howm-time< howm-menu-next-expiry-time
226 (howm-menu-refresh f place name)
227 (switch-to-buffer b))
228 (let ((cm major-mode))
232 (setq pb howm-menu-previous-buffer)
234 (setq pm major-mode)))
235 (setq howm-menu-previous-buffer pb))))
237 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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.")
247 (defun howm-menu-refresh (&optional file place name)
251 (switch-to-buffer (get-buffer-create name)))
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
257 (setq howm-menu-shortcut-assoc nil)
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))
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))
273 (defun howm-menu-insert-paragraph (file place)
274 (insert-file-contents (expand-file-name file
276 (howm-view-set-place place)
277 (let* ((r (howm-view-paragraph-region))
280 (delete-region e (point-max))
281 (delete-region (point-min) b))
282 (goto-char (point-max))
283 (insert (howm-menu-footer)))
285 ;; (defun howm-menu-dynamic-setup ()
286 ;; (let* ((action-lock-default-rules (howm-menu-action-lock-rules)))
288 ;; (howm-initialize-buffer)
290 ;; (howm-menu-shortcut-initialize)
291 ;; (howm-menu-replace howm-menu-display-rules))
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)))
298 (howm-initialize-buffer)
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)))
308 (defun howm-menu-footer ()
310 (let* ((r (howm-menu-command-table-raw))
311 (buttons (mapcar (lambda (f)
317 '(howm-menu-refresh howm-menu-edit)))
318 (footer (apply #'concat `("\n-- \n" ,@buttons))))
319 (setq howm-menu-footer footer)
322 (defun howm-menu-refresh-background ()
323 ;; save-current-buffer doesn't work on GNU Emacs 21.4.1
324 (let ((b (current-buffer)))
326 (switch-to-buffer b)))
328 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
331 (defun howm-menu-invoke (arg)
333 (cond ((save-excursion
335 (looking-at howm-menu-list-regexp))
337 (action-lock-invoke arg))
338 ((howm-menu-list-get-item)
339 (howm-view-open-item (howm-menu-list-get-item)))
341 (error "Not on spell string."))))
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))
352 `(list (match-string-no-properties ,n))
355 (c (howm-menu-action functab args)))
357 (howm-menu-command-table))))
360 ;; Elisp is not Scheme. Lambda is not closure. Don't forget dynamic binding.
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)
377 (cur (current-buffer))
378 (prev (if (howm-buffer-alive-p howm-menu-previous-buffer)
379 howm-menu-previous-buffer
383 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
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))
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))
402 (defun howm-menu-shortcut-sort (keys)
403 (mapconcat #'identity
404 (sort (copy-sequence keys) #'string<)
407 (defun howm-menu-shortcut-warn ()
408 (when *howm-menu-shortcut-multidef-keys*
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*))))
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))
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*))))
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)))
443 ;; old code. it works.
444 (defun howm-menu-shortcut-func1 (p move-only)
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)))))))
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)
462 `(lambda (arg) (interactive "P") (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)))
470 (lambda (arg) (interactive "P") nil)
472 (rplacd (assoc key howm-menu-shortcut-assoc)
476 (funcall (cdr (assoc ,key howm-menu-shortcut-assoc))
479 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
482 (defun howm-menu-edit ()
484 (let ((place howm-menu-buffer-file-place))
485 (find-file (expand-file-name howm-menu-buffer-file howm-directory))
488 (howm-view-set-place place)
491 (defun howm-menu-eval (s)
492 (let ((expr (read s)))
495 (defun howm-menu-call (s)
496 (let ((expr (read s)))
497 (call-interactively expr)))
499 (defun howm-open-today ()
501 (and (howm-create-file t)
502 (howm-insert-template ""))
505 (defun howm-open-past (&optional days-before)
507 (setq days-before (or days-before 1))
508 (if (= days-before 0)
510 (howm-open-past-sub days-before)))
512 (defun howm-open-past-sub (days-before)
513 (let ((f (expand-file-name (howm-file-name (howm-days-after (current-time)
516 (if (file-exists-p f)
518 (error "No such file: %s" f)))
521 (defun howm-find-past (&optional days-before)
523 (cond ((howm-one-file-one-day-p) (howm-open-past days-before))
524 (t (howm-search-past days-before))))
526 (defun howm-find-today (&optional days-before)
528 (howm-find-past (or days-before 0)))
530 (defun howm-find-yesterday (&optional days-before)
532 (howm-find-past (or days-before 1)))
534 (defun howm-one-file-one-day-p ()
535 (let* ((now (decode-time))
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))))
544 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
547 (defun howm-menu-make-invisible ()
549 (goto-char (point-min))
552 (while (not (= (point) (point-max)))
554 (while (re-search-forward howm-menu-toggle-invisible
555 (line-end-position) t)
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))))
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...
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)))
584 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
587 (defun howm-menu-replace (rules)
589 (let* ((reg (car 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))))))
598 ;; (defun howm-menu-func ()
599 ;; (let ((b (match-beginning 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))))
607 ;; (defun howm-menu-var ()
608 ;; (let ((b (match-beginning 0))
610 ;; (f (read (match-string-no-properties 1))))
611 ;; (howm-replace-region b e (eval f))))
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)
621 (t (message "Unknown expr: %s" expr)))))
623 (defun howm-menu-here-var (expr beg end)
625 (howm-replace-region beg end (symbol-value expr))
626 (message "Unknown symbol: %s" expr)))
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))))))
635 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
636 ;; schedule, todo, recent, random
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)))
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)))
657 (defun howm-menu-recent (&optional evaluator label)
658 (howm-menu-general (or label "recent")
660 (howm-recent-menu howm-menu-recent-num evaluator)))
662 (defun howm-menu-random () (howm-menu-recent t "random"))
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
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)
677 (let* ((msg "scanning %s...")
678 (msg-done (concat msg "done")))
680 ;; (delete-region (match-beginning 0) (match-end 0))
682 (mapconcat f item-list "\n")
683 (message msg-done label)))))
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)
693 (howm-menu-format-reminder item dow-str t))))
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)))
699 (dow-str (or day-of-week-str
700 (howm-day-of-week-string dow)))
701 (priority (if (and howm-menu-todo-priority-format
703 (format howm-menu-todo-priority-format
704 (howm-todo-priority item))
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)))
710 (defun howm-day-of-week-string (&optional day-of-week)
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))
718 (defun howm-menu-format-full (item)
719 (let ((text (format "%s %s\n%s"
721 (howm-item-name item)
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)
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))
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)))
748 (cl-mapcan (lambda (f)
749 (let ((is (howm-view-search-items r (list f)
751 (and is (list (nth (random (length is))
754 (howm-first-n (howm-view-search-items r files summarizer) num)))))
756 (defun howm-menu-recent-regexp ()
757 (or howm-menu-recent-regexp (howm-view-title-regexp-grep)))
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)))
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
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)))
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)
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)))
792 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
793 ;; embed search result
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.
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"
807 (howm-view-search-folder-items key (howm-folder)
810 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
811 ;; categorized todo-list
813 ;; Experimental [2006-01-16]
815 (defun howm-menu-classified-reminder (classifier &optional comparer
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
828 ;; key 'nil' is skipped.
829 (keys (remove nil (mapcar #'car a)))
830 (tform (concat (or title-format "--%s--") "\n")))
832 (setq keys (sort keys comparer)))
833 (mapconcat (lambda (k)
834 (let* ((item-list (howm-first-n (cdr (assoc k a))
836 (is (howm-with-reminder-setting
837 (howm-todo-insert-separators
839 howm-menu-reminder-separators
841 (concat (format tform k)
842 (howm-menu-general (format "reminder(%s)" k) 'todo
846 (defun howm-menu-categorized-reminder (categories &optional title-format
848 "Generate string of categorized reminder-list.
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.)
855 If you like to erase category label from summary string, try
856 %here%(howm-menu-categorized-reminder (\"foo\" \"bar\" \"baz\") nil t)
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)
867 (howm-item-set-summary item
868 (replace-match "" nil nil
871 (classifier (lambda (item)
872 (let ((s (howm-item-summary item)))
873 (or (cl-find-if (lambda (c)
874 (funcall matcher c s item))
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)))
881 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
882 ;; generate initial menu
884 (defun howm-menu-initialize-skel (&optional dummy)
885 (let ((menu-name (howm-get-symbol nil "howm-menu-" howm-menu-lang)))
887 (howm-menu-copy-skel (symbol-value menu-name))
888 (howm-view-kill-buffer)
891 (defun howm-menu-copy-skel (contents)
892 (let ((menu-file (or howm-menu-file
893 (expand-file-name "0000-00-00-000000.txt"
896 (if (file-exists-p menu-file)
897 ;; I have no courage to erase existing file.
899 (setq howm-menu-file menu-file)
900 (message "Assume %s as menu file." menu-file))
902 (find-file menu-file)
904 (goto-char (point-min))
905 (while (re-search-forward r nil t)
906 (replace-match howm-view-title-header nil nil))
910 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
913 (defun howm-require-lang (&optional lang)
914 (require (howm-get-symbol nil "howm-lang-" (or lang howm-menu-lang))))
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))))
923 (defun howm-menu-command-table-raw ()
924 (howm-lang-ref "howm-menu-command-table"))
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))))
931 (defun howm-day-of-week ()
932 (howm-lang-ref "howm-day-of-week"))
934 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
937 (defun howm-menu-p ()
938 (string= major-mode "howm-menu-mode"))
940 (defun howm-menu-name (file)
941 (format howm-menu-name-format file))
943 (defun howm-buffer-alive-p (buf)
944 (and buf (buffer-name buf)))
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)))
951 (defun howm-time< (t1 t2)
952 (or (< (car t1) (car t2))
953 (and (= (car t1) (car t2))
954 (< (cadr t1) (cadr t2)))))
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)
963 ;;; howm-menu.el ends here